Comments on macro to help solve the problem of Excel changing column widths

[JenniferMurphy]

Here's macro that I think will allow me to restore the widths of the columns in a sheet after they get screwed up when I move or insert columns.

It requires a row of cells in the columns in question. It has two "paths". (1) It will store the current widths in the selected cells. (2) It will restore the widths of the columns to the values in the selected cells.

Before I do something that I fear might screw up some column widths, I select a row of cells in those columns and call the macro to fill in the current widths. If any columns get screwed up, I select those same cells and call the macro to restore the columns to the width in the selected cells. It works great. I have not found an cases that fail.

I would appreciate any comments or suggestions.

The one thing I do not like about it is the MsgBox. I wish MsgBox would allow custom buttons. I am trying to decide whether to just live with it, replace it with a userform, or switch to two macros called by two button controls. I'd also appreciate any comments or suggestions on that.

Sub ManageColumnWidths()
Const MyName As String = "ManageColumnWidths"
    
Const MaxColumns As Long = 100
Dim actionChoice As VbMsgBoxResult
Dim cell As Range
Dim colWidth As Double
Dim MsgText As String

' Check that the selection is a single row
If Selection.Rows.Count > 1 Or Selection.Areas.Count > 1 Then
   MsgBox "Please select a single row (not multiple rows or non-contiguous cells).", vbExclamation, MyName
   Exit Sub
End If
    
' Check that the selection length is reasonable (not the entire row)
If Selection.Columns.Count > MaxColumns Then
   MsgText = "Selection is > " & MaxColumns & " cells. Do you want to proceed anyway?"
   If MsgBox(MsgText, vbYesNo + vbExclamation, MyName) = vbNo Then
      Exit Sub
   End If
End If
    
'Ask the user what action to take
MsgText = "Select the action to perform:" & vbCrLf _
        & "Yes = Store column widths in the selected cells" & vbCrLf _
        & "No = Restore column widths from the selected cells" & vbCrLf _
        & "Cancel = Exit."
actionChoice = MsgBox(MsgText, vbYesNoCancel + vbQuestion, MyName)
    
Select Case actionChoice
   Case vbYes                    'Store column widths in the selected cells
      For Each cell In Selection    'Loop thru each cell in the selected range
        colWidth = cell.ColumnWidth    'Get the width in character units
        'Debug.Print "Storing Column " & cell.Column & " Width (Pixels): " & colWidth
        cell.Value = colWidth          'Store the width in the cell
      Next cell
   Case vbNo                     'Restore the column widths from the selected cells
      For Each cell In Selection    'Loop thru each cell in the selected range
         colWidth = cell.Value         'Get the width value from the cell
         'Debug.Print "Restoring Column " & cell.Column & " Width: " & colWidth
         cell.ColumnWidth = colWidth   'Set the width of the corresponding column
      Next cell
   Case Else                     'Exit
End Select

End Sub

 

[Sergius]

I wish MsgBox would allow custom buttons.

Hello! Read this article, which I think you will find useful.

 

[JenniferMurphy]

I have been using this macro for a day now. It works great. Here's a little demo of how it works.

Here's a screen shot of a sample table for tracking the power rankings of some teams. I have it set up the way I want it. I will post the minisheet at the end.

The first thing I do is select the Column Width cells above each column (B2:H2) then click the Column Widths button to call my macro. I select Yes to fill in the current widths. The macro fills in the widths for the selected cells in Character units. The units were a problem. You can check that the widths are correct by selecting a cell and going to Format | Column Width... in the Cell section.

Just as a little test, I selected all 8 columns and changed their widths.

I restore them all by selecting those same 8 cells (B2:H2) and calling the macro. This time I chose "No", which tells the macro to change each column to the width in the corresponding cell. Voila. Like magic all of the widths are restored.

If I set up a Column Width row and have the macro fill i the widths, I can do whatever column manipulation I want by calling the macro. If I have done some work and the column widths are messed up and I want to restore them, but I want to keep the current width of one or more columns, I just have to select those cells and have the macro fill in the current widths. Then select all of the cells and have the macro restore widths.

I just got the Week 3 rankings. I need to add another set of 3 columns. I do that to the right of current set. That makes updating the headers easier. I select columns F:H, right-click, and select Insert.

Next I copy the 3 column widths to the new columns. I don't run the macro just yet.

Next I copy the headers and edit them. This is easier on the right. If I copy then on the left, Excel changes the current headers so I have to edit all 6.

Now I am ready to move the new columns into place. I select F:G and Ctrl-Drag them to between B & C. This is where the columns get all messed up.

Macro to the rescue! I just select the width columns (B2:K2), click the Column Widths button, and select "No". In the blink of an eye. All of the columns are restored.

I still have a little work to do, but the columns are fixed.

I did find a bug in the code. It did not check that all of the cells have valid widths. An empty cell would case it to set that width to zero.

Here's the fixed code.

Sub ManageColumnWidths()
Const MyName As String = "ManageColumnWidths"
   
Const MaxColumns As Long = 100
Dim actionChoice As VbMsgBoxResult
Dim cell As Range
Dim colWidth As Double
Dim MsgText As String
   
'' Clear the Immediate window with divider lines
'Call ClearImmediateWindow(MyName)

' Check that the selection is a single row
If Selection.Rows.Count > 1 Or Selection.Areas.Count > 1 Then
   MsgBox "Please select a single row (not multiple rows or non-contiguous cells).", vbExclamation, MyName
   Exit Sub
End If
   
' Check that the selection length is reasonable (not the entire row)
If Selection.Columns.Count > MaxColumns Then
   MsgText = "Selection is > " & MaxColumns & " cells. Do you want to proceed anyway?"
   If MsgBox(MsgText, vbYesNo + vbExclamation, MyName) = vbNo Then
      Exit Sub
   End If
End If
   
'Ask the user what action to take
MsgText = "Select the action to perform:" & vbCrLf _
        & "Yes = Store column widths in the selected cells" & vbCrLf _
        & "No = Restore column widths from the selected cells" & vbCrLf _
        & "Cancel = Exit."
actionChoice = MsgBox(MsgText, vbYesNoCancel + vbQuestion, MyName)
   
Select Case actionChoice
   Case vbYes                    'Store column widths in the selected cells
      For Each cell In Selection    'Loop thru each cell in the selected range
        colWidth = cell.ColumnWidth    'Get the width in character units
        cell.Value = colWidth          'Store the width in the cell
      Next cell
   Case vbNo                     'Restore the column widths from the selected cells
      For Each cell In Selection    'Loop thru each cell in the selected range
         If Not Application.IsNumber(cell.Value) Or cell.Value <= 0 Then
            MsgBox "Cell " & cell.Address & " is not valid", vbOKCancel, MyName
            Exit Sub
         End If
         colWidth = cell.Value         'Get the width value from the cell
         cell.ColumnWidth = colWidth   'Set the width of the corresponding column
      Next cell
   Case Else                     'Exit
End Select

End Sub

And here is the mini-sheet for the test sheet I used for these examples.

Macro Move or Copy Columns.xlsx
	A	B	C	D	E	F	G	H	I	J	K
2	Col Widths	6.82	3	3	4.82	3	3	4.82	3	3.2	25.73
3			Week 3			Week 2			Week 1
4		Team	Wk 3 Rank	Wk 3 Δ	Wk 3 Record	Wk 2 Rank	Wk 2 Δ	Wk 2 Record	Wk 1 Rank	Wk 1 Record	Comments
5		C	1	+1	2-0	2	+1	1-0	3	0-0	Relocated last year
6		f	2	+1	1-1	3	+3	1-0	6	0-0	First year in league
7		A	3	-2	1-1	1	=0	1-0	1	0-0	New ownership
8		D	4	=0	1-1	4	=0	0-1	4	0-0	Youngest players in the league
9		E	5	+1	1-1	6	-1	0-1	5	0-0	Oldest players in the league
10		B	6	-1	0-2	5	-3	0-1	2	0-0	Last year's champion
Mr Excel

Cell Formulas
Range	Formula
D5:D10	D5	=LET(New,[@[Wk 3 Rank]],IF(ISNUMBER(New),[@[Wk 2 Rank]]-New,"--"))
G5:G10	G5	=LET(New,[@[Wk 2 Rank]],IF(ISNUMBER(New),[@[Wk 1 Rank]]-New,"--"))

I would appreciate any comments or suggestions.

 

[JenniferMurphy]

Hello! Read this article, which I think you will find useful.

I think that article is over my head. Plus that site is infested with ads. They are everywhere. And they keep popping up and moving the text that I am trying to read around.

 

[Sergius]

I have an ad blocker, so I don’t know if there are ads there or not. As for the script, I use it myself in my project. I am completely satisfied with how the script works.
P.S. I apologize if visiting this site has caused you any inconvenience.

 

[JenniferMurphy]

I have an ad blocker, so I don’t know if there are ads there or not. As for the script, I use it myself in my project. I am completely satisfied with how the script works.
P.S. I apologize if visiting this site has caused you any inconvenience.

No need to apologize. I didn't mean to sound critical of you. Sorry if it sounded that way. The main thing is that is looked too complicated for me to manage. I don't like to install stuff that I don;t understand.

I need to get an ad blocker. I have been meaning to do that. Do you use Firefox? If so, may I ask what ad blocker do you use?

 

[Alex Blakenburg]

I am not sure the macro would be any easier than simply selecting the three Week2 columns and copy pasting the format to the Week3 columns.
In terms of the macro, I suspect it would be a good idea to come up with some sort of check that the column width output doesn't overwrite existing data especially since there will be no Undo option.

The below is probably not enough but at least stops you overwriting data in the table.

Select Case actionChoice
   Case vbYes                    'Store column widths in the selected cells
    ' Check that the selection is not a row of the table
        Dim lo As ListObject
        For Each lo In ActiveSheet.ListObjects
            If Not Intersect(Selection, lo.Range) Is Nothing Then
                  MsgBox "Output will overwrite existing data in Selected range and should be outside the table", vbExclamation, MyName
                  Exit Sub
            End If
        Next lo
   
        ' Check that the selection length is reasonable (not the entire row)
        If Selection.Columns.Count > MaxColumns Then
           MsgText = "Selection is > " & MaxColumns & " cells. Do you want to proceed anyway?"
           If MsgBox(MsgText, vbYesNo + vbExclamation, MyName) = vbNo Then
              Exit Sub
           End If
        End If

 

[JenniferMurphy]

I am not sure the macro would be any easier than simply selecting the three Week2 columns and copy pasting the format to the Week3 columns.

I do that. But before I have anything to copy formats to, I have to insert columns. And when I do that, and also when I delete columns, columns get resized.

In terms of the macro, I suspect it would be a good idea to come up with some sort of check that the column width output doesn't overwrite existing data especially since there will be no Undo option.

Good point. I have added something like what you suggest.

Thanks

 

[wellsr]

I think that article is over my head. Plus that site is infested with ads. They are everywhere. And they keep popping up and moving the text that I am trying to read around.

Thank you for mentioning the behavior of the ads on my site! I just removed all ads from the site this morning after a reader sent me a screenshot from this thread - hopefully that improves your experience. I'm really sorry about the ads bouncing around and moving the text on the page.

It may take a while for the cache to clear for everybody, but if you want to force it to an ad-free experience before the cache clears, you can append "?v=1" to the end of the URL.

 

[JenniferMurphy]

Thank you for mentioning the behavior of the ads on my site! I just removed all ads from the site this morning after a reader sent me a screenshot from this thread - hopefully that improves your experience. I'm really sorry about the ads bouncing around and moving the text on the page.

It may take a while for the cache to clear for everybody, but if you want to force it to an ad-free experience before the cache clears, you can append "?v=1" to the end of the URL.

Thank you.

I don't mind ads per se. People like you who go to a lot of trouble to make valuable information available for free deserve to be compensated. My problem is with ads in the middle of what I am trying to read. Websites that do it right, IMHO, have the screen divided into three sections. The middle section, with 70%-80% of the screen, contains the subject of the page. The two side sections contain the ads. The ads do not encroach on the middle section.

I'll take another look at your website. I still fear that it is over my head. My inclination is to use a userform, which I mostly understand and which is built in.

My suggestion to make it more accessible to those like me with moderate Excel skills is to start with a very brief overview with a couple of examples, any caveats, and the simplest installation guide. One of my concerns about any "add-ins" is whether they will screw up anything, such as messing up the Excel update. I have had a few problems. If you can also provide some comments about how it compares to the alternatives, like userforms. Then provide links to more detailed information for those who can follow it.

Again, thanks for your efforts to make contributions.