Is there no way to move table columns and preserve all column widths?

[JenniferMurphy]

Whenever I had tried to move a table column, the widths of many of the other columns get all messed up. I've tried moving just the table columns (by dragging the table header) and moving the sheet column (by dragging the column header). They each mess up other column widths, but in different ways.

The table I am currently working on is way too large to post as a minisheet. If examples are needed, I can try creating a test table.

This was discussed in this thread about 18 months ago with no solution:

Excel Table : moving a column messes up with the width of other columns

- OS : MacOS and Windows (tested on both) - Excel version : 16.64 - Issue When I do SHIFT + drag & drop a column within an Excel Table (it's NOT a Pivot Table, it's a normal Table), it will mess up with the column widths. It doesn't behave like this when it's not a Table. - Screenshots of...

www.mrexcel.com

And it referred to this tread in the Microsoft Community, also with no solution:

Redirecting

Is there a way to move columns and preserve all column widths, or is this just another M$FT bug that will be ignored for 20 years?

 

[JenniferMurphy]

Does anyone have a macro that will effectively reorder columns and preserve all widths? It could prompt for a text string representing the new column order.

A text string like "b e c d h f g" would move column E over between B & C and H over between H over between D & F.

If there is one, I'd be happy to test it.

 

[JenniferMurphy]

No one has posted a macro, so I started to write one myself.

I got this code from the Macro Recorder for moving Column C to the right of Column D. It sorta works.

Columns("C:C").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("E:E").Select
Selection.ColumnWidth = 10

I was initially puzzled by the "E:E" when I made the move to the right of D. Then I realized that when C is cut, D becomes E.

The move is working, but the width setting (last 2 statements) is not. Columns B:H are a table. The first time I run the macro, those commands apply to Column I, not E. I is the column to the right of the table. If I run it again, it changes the width of J. Each successive time, it affects the next column to the right (K, L, M, ...)

Is there a way I can refer to the columns by numbers? I am not sure how I can keep track of the moves if I have to use letters.

Thanks

 

[Alex Blakenburg]

See if this gives you any ideas. The assumption is that the issue is only when rearranging table columns.
It picks the table from the active cell and sorts based on a row with numbers representing the required column order immediately above the table.

   Sub ReOrderTableColumns()
    ' The code relies on the row directly above the table containing
    ' a sequential series of numbers which will be used to sort the columns
    ' It uses the active cell to determine the table to be sorted
   
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim rngHdr As Range, cellHdr As Range
    Dim rngSort As Range
    Dim dictCol As Object, dictKey As String
   
    Set ws = ActiveSheet
   
    ' Select Table using the active cell
    On Error Resume Next
    Set tbl = ActiveCell.ListObject
    On Error GoTo 0
   
    'Confirm if a cell is in a Table
    If tbl Is Nothing Then
        MsgBox "Select table and try again"
        Exit Sub
    End If
   
    Set rngHdr = tbl.HeaderRowRange
   
    Set dictCol = CreateObject("Scripting.dictionary")
   
    ' Load column widths into Dictionary
    For Each cellHdr In rngHdr.Cells
        dictKey = cellHdr.Value
        dictCol(dictKey) = ws.Columns(cellHdr.Column).ColumnWidth
    Next cellHdr
   
    ' Move columns
    Set rngSort = tbl.Range.Resize(tbl.Range.Rows.Count + 1).Offset(-1)
   
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add2 Key:=rngSort.Rows(1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Final").Sort
        .SetRange rngSort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
   
    ' Reset Column widths
    For Each cellHdr In rngHdr.Cells
        dictKey = cellHdr.Value
        ws.Columns(cellHdr.Column).ColumnWidth = dictCol(dictKey)
    Next cellHdr

End Sub

My sample Data:

20240421 ListObject Tables Move Column column width JenniferMurphy v03.xlsm
	B	C	D	E	F	G	H	I	J	K	L
1	10	9	8	7	6	5	4	3	2	1	0
2	Num	Date	ID	Price	Comments	More Cols another col	Qty	total	More Cols2	More Cols22	More Cols222
3	1	20-Apr-24	abc123	9.99	This field contains some text	abc	10	99.9	abc	abc	abc
4	2	3-Apr-24	xyz999	19.99	Here's some more text	def	10	199.9	def	def	def
5	3	5-Mar-24		29.99	And still more and more	zzz	10	299.9	zzz	zzz	zzz
Final

Cell Formulas
Range	Formula
I3:I5	I3	=[@Price]*[@Qty]