Problem to ColumnWidth

Hi,

Further to this thread,
https://www.experts-exchange.com/questions/29086897/Problem-to-SaveAs-line.html#a42487490

what can be the reason of error
21u.png
due to last ColumnWidth line below
            ...
            Application.Workbooks(Window0).Close SaveChanges:=False
            If cnt0 = 1 Then
                Set HOBook = Workbooks.Add
                With HOBook
                    .Title = Title0
                    .Subject = Title0
                    .SaveAs Filename:=File0, FileFormat:=XlFileFormat.xlOpenXMLWorkbookMacroEnabled
                    '.SaveAs Filename:=File0, FileFormat:=xlOpenXMLWorkbookMacroEnabled
                    .Close SaveChanges:=False
                End With

                With Worksheets("Sheet1").Columns("A")
                 .ColumnWidth = .ColumnWidth * 2
                End With

                With Worksheets("Sheet1").Columns("B")
                 .ColumnWidth = .ColumnWidth * 2
                End With

                With Worksheets("Sheet1").Columns("D")
                 .ColumnWidth = .ColumnWidth * 2
                End With

                With Worksheets("Sheet1").Columns("E")
                 .ColumnWidth = .ColumnWidth * 2
                End With

                With Worksheets("Sheet1").Columns("F")
                 .ColumnWidth = .ColumnWidth * 3.5
                End With

Open in new window

LVL 11
HuaMin ChenSystem AnalystAsked:
Who is Participating?
 
Roy CoxGroup Finance ManagerCommented:
Your code multiplies the columnwidth by two, so eventually it is going to cause problems. The result needs checking first

   
 With Worksheets("Sheet1").Columns("A")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else: MsgBox "Cannot increase Column Width"
               Exit Sub
        End With
    End If

Open in new window

0
 
Rgonzo1971Commented:
Hi,

is there a merged cell or
Maximum attainable column width is 255.

Regards
0
 
Roy CoxGroup Finance ManagerCommented:
Is the worksheet or workbook protected?
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
ste5anSenior DeveloperCommented:
Just a comment:

Multiplying column widths is pretty uncommon. I use either AutoFit() or fixed column width values.

Clean up your code.. e.g.

Option Explicit

Private Sub MultiplyColumnWidth(ARange As Excel.Range, AFactor As Double)

  ARange.ColumnWidth = ARange.ColumnWidth * AFactor

End Sub
                               
Public Sub test()

  Dim CurrentSheet As Excel.Worksheet
                
  Set CurrentSheet = Worksheets(2)
  MultiplyColumnWidth CurrentSheet.Columns("A"), 2
  MultiplyColumnWidth CurrentSheet.Columns("B"), 2
  MultiplyColumnWidth CurrentSheet.Columns("D"), 2
  MultiplyColumnWidth CurrentSheet.Columns("E"), 2
  MultiplyColumnWidth CurrentSheet.Columns("F"), 3.5
  Set CurrentSheet = Nothing

End Sub

Open in new window


Cause now you can add proper error handling to your method.
0
 
HuaMin ChenSystem AnalystAuthor Commented:
Thanks to all.
There is no merged cell. Worksheet and Workbook is not protected.
0
 
Rgonzo1971Commented:
and what is the goal width of Col F?
0
 
Rgonzo1971Commented:
In my 2 answers, I pointed the problem of the max width, but you ignored them, pls read carefully all answers
1
 
ste5anSenior DeveloperCommented:
And I would do it like this:

Option Explicit

Private Sub MultiplyColumnWidth(ARange As Excel.Range, AFactor As Double)
  
  On Local Error GoTo LocalError

  Const MAX_COLUMN_WIDTH As Long = 255
  
  Dim NewWidth As Long
  
  NewWidth = ARange.ColumnWidth * AFactor
  If NewWidth <= MAX_COLUMN_WIDTH Then
    ARange.ColumnWidth = NewWidth
  Else
    Debug.Print "Column " & ARange.Address & " exceeds minmium width (" & ARange.ColumnWidth & ") for current factor (" & AFactor & ")."
  End If
  
  Exit Sub

LocalError:
  Debug.Print "Error " & Err.Number & " while settting new width of " & ARange.Address & "."

End Sub
                               
Public Sub test()

  Dim CurrentSheet As Excel.Worksheet
                
  Set CurrentSheet = Worksheets(1)
  MultiplyColumnWidth CurrentSheet.Columns("A"), 2
  MultiplyColumnWidth CurrentSheet.Columns("B:C"), 2
  MultiplyColumnWidth CurrentSheet.Columns("D"), 2
  MultiplyColumnWidth CurrentSheet.Columns("E"), 2
  MultiplyColumnWidth CurrentSheet.Columns("F"), 3.5
  Set CurrentSheet = Nothing

End Sub

Open in new window

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.