Rearrange column headers using listbox

[gaudrco]

I'm looking for a way to move line items in a listbox to rearrange the order of my table headers. So maybe a click and drag approach where I click and hold one line item in my listbox and drag it to a different position in the listbox so that it changes the table header location. Or maybe another approach could be to use two buttons. One button moves the line item up one and the other moves the line item down one. So you could click a listbox line item and use the buttons to move it up or down, which would ultimately change the location of the column headed on the table.

Background:
I have two listbox that use the column headers of a table as the listbox line items. The two listboxes allow me to show and hide columns of my table. When a listbox item is double-clicked, the list item is moved to the other listbox. ListboxVisible shows the columns and ListboxHidden hides the column.
Here is the code that accomplishes that:

Private Sub ToggleVisible_Click()Columns(4).Resize(, 37).Hidden = Not Columns(4).Resize(, 37).Hidden
UpDate_List
End Sub
Private Sub ListboxHidden_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
On Error GoTo M
Cancel = True
Dim c As Long
Dim i As Long
Cells(7, 4).Resize(, 37).Select
    Selection.Find(What:=ListboxHidden.Value, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        c = ActiveCell.Column
        Columns(c).Hidden = False
        
For i = 0 To ListboxHidden.ListCount - 1
    If ListboxHidden.Selected(i) Then
        ListboxHidden.RemoveItem (i)
    End If
Next i
ListboxHidden.ListIndex = -1
Call UpDate_List
Range("B1").Select
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "No value selected"
End Sub
Private Sub ListboxVisible_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
On Error GoTo M
Cancel = True
Dim c As Long
Dim i As Long
Cells(7, 4).Resize(, 37).Select
    Selection.Find(What:=ListboxVisible.Value, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        c = ActiveCell.Column
        Columns(c).Hidden = True
        
For i = 0 To ListboxVisible.ListCount - 1
    If ListboxVisible.Selected(i) Then
        ListboxVisible.RemoveItem (i)
    End If
Next i
ListboxVisible.ListIndex = -1
Call UpDate_List
Range("B1").Select
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "No value selected"
End Sub


Private Sub UserForm_Initialize()
For i = 4 To 40
    If Columns(i).Hidden = True Then ListboxHidden.AddItem Cells(7, i).Value
    If Columns(i).Hidden = False Then ListboxVisible.AddItem Cells(7, i).Value
Next
ListboxHidden.ControlTipText = "Double-click on me to SHOW this column"
ListboxVisible.ControlTipText = "Double-click on me to HIDE this column"


End Sub
Sub UpDate_List()
ListboxHidden.Clear
ListboxVisible.Clear
For i = 4 To 40
    If Columns(i).Hidden = True Then ListboxHidden.AddItem Cells(7, i).Value
    If Columns(i).Hidden = False Then ListboxVisible.AddItem Cells(7, i).Value
Next
End Sub


Private Sub CloseUserForm2_Click()
UserForm2.Hide
End Sub
Private Sub CommandButton1_Click()
UserForm2.Hide
UserForm1.Show
End Sub

 

[gaudrco]

And just like that its fixed! Thank you Yongle

 

[gaudrco]

    Dim cel As Range, i As Long
    Set cel = Sheets("NameOfSheet").Range("[COLOR=#ff0000]C2[/COLOR]")        [COLOR=#ff0000]'first header cell[/COLOR]
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            cel.Offset(, i) = .List(i)
        Next i
    End With

This works great but I am having a technical issue that I believe can be resolved with this.

Right before the columns are renamed, I need the current column headers deleted. The issue is that when I click the button to have the columns renamed, the table recognizes that there are duplicate headers, so to correct this, I believe I need to delete the existing headers first, then they can be renamed with the order of the listbox.

 

[Yongle]

Amend sheet name and range

Sheets("ABC").Range("D1:G1").ClearContents

 

[gaudrco]

That will not work because in some cases, I will have certain columns hidden. So I need a code that selects the range I have below, but only the visible cells. If a column is hidden, then I need the header for that column to remain the same.

Range("A7").Offset(0, 3).Select
Range(Selection, Selection.End(xlToRight)).Select

 

[Yongle]

Try adding this line below the code in post#24

[COLOR=#000000][FONT=Menlo]Selection.SpecialCells(xlCellTypeVisible).ClearContents[/FONT][/COLOR]

 

[gaudrco]

Try adding this line below the code in post#24

[COLOR=#000000][FONT=Menlo]Selection.SpecialCells(xlCellTypeVisible).ClearContents[/FONT][/COLOR]

Thank you. That worked but I am still having a hiccup in my code. The problem is that when I run this code, some of my columns names become "Column1", "Column2", "Column3" etc. I am trying to get it so that when I click this button, the current order of the listbox items replaces the order of the table column headers. Here is the code I have:

Private Sub Userform3Finish_Click()
UserForm3.Hide
 Range("A7").Offset(0, 3).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
 
 Dim cel As Range, i As Long
    Set cel = Sheets("Competitor Comparison").Range("A7").Offset(0, 3)       'first header cell
    With Me.Listboxreorder
        For i = 0 To .ListCount - 1
            cel.Offset(, i) = .List(i)
        Next i
    End With
End Sub

 

[gaudrco]

I think the problem is in the last part of the code. I think when the names from the listbox transpose to the table, the names are not skipping over the hidden columns. Perhaps if the code were written to say that the transposed list items from the listbox also skip over columns that are hidden, this may work.

 

[Yongle]

How about ..

Private Sub Userform3Finish_Click()
    Dim c As Variant, i As Long, rng As Range
    UserForm3.Hide
'avoid duplicated header names by clearing visible headers
    Set rng = Cells(7, 4).Resize(, 37)
    rng.SpecialCells(xlCellTypeVisible).ClearContents
'new header names
    For Each c In rng.Columns
        If c.ColumnWidth > 0 Then
            Cells(7, c.Column) = Me.Listboxreorder.List(i)
            i = i + 1
        End If
    Next
End Sub

The above assumes that the list of visible columns is the SAME as the actual visible columns in the range

 

[gaudrco]

There is an error on the line below

Run-time error 381
Could not get the List Property. Invalid property array index

[COLOR=#333333] Cells(7, c.Column) = Me.Listboxreorder.List(i)[/COLOR]

 

[Yongle]

what is the value of i when it fails ?