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

 

[Yongle]

I did amend the code immediately after posting it
- check you are using the amended code

 

[gaudrco]

I'm sorry I not sure how to tell. It does seem like the code works properly and the names change correctly. It just has a random error that comes up.

 

[Yongle]

Try this

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
           [COLOR=#ff0000] If i = Me.ListBox1.ListCount Then Exit For[/COLOR]
        End If
    Next
End Sub

 

[gaudrco]

It is work now! Thank you!

 

[Yongle]

But do you understand why it now works when it did not before ?

 

[gaudrco]

No I don't really understand to be honest. This code is too complex for me. I am a novice

 

[Yongle]

let's try ..

If a column is hidden then its width is Zero
- and that is the test that is used to determine which columns are visible
- every time a visible column is detected, variable i is increased by 1
- variable i determines the next item in the list

.ListCount is the number of items in your listbox

the items in the list are held in collection referred to as .List
( where the 1st item is .List(0) and therefore the last item is .List( .ListCount -1)

I expected the number of ACTUAL visible columns in your header range to be identical to .ListCount
- but there must have been more visible columns than items in the list because the code ran out of list items before it ran out of visible columns

The adjustment to the code simply tells VBA to stop when it gets to the end of the list

Q Are there any columns in your range with ColumnWidth = 0 which are NOT hidden ?
Q Do some of your visible columns have empty header cells ?

( I would like to understand why the numbers differ )

 

[gaudrco]

Thank you for the explanation

Q Are there any columns in your range with ColumnWidth = 0 which are NOT hidden ?

No, I don't think so.

Q Do some of your visible columns have empty header cells ?

Yes. The listbox loads many empty column headers but I have a code that removes blanks from the list. The empty headers are reserved for new columns that get added. So if someone adds a new column to the table, then the new header will replace the blank and will show up in the listbox.

 

[Yongle]

Thanks - that explains everything - all is good