Rearrange column headers using listbox

gaudrco

Board Regular
Joined
Aug 16, 2019
Messages
203
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:
Code:
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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Here is a method to move items up and down in userform listbox

To test ...
- create a NEW userform
- add a Listbox (ListBox1)
- add a SpinButton (SpinButton1)
- paste code below into UserForm module

Run Userform \ select animal \ click on SpinButton Up or Down arrow

Code:
Private Sub UserForm_Activate()
    ListBox1.List = Split("Cat Cow Dog Eel Elk Fox Owl Yak")
    With SpinButton1
        .Value = 0
        .Max = 1
        .Min = -1
        .SmallChange = 1
    End With
End Sub

Private Sub SpinButton1_Change()
    MoveItem -SpinButton1.Value
    SpinButton1.Value = 0
End Sub

Private Sub MoveItem(X As Long)
    Dim itms As String, i As Long, lbVal As String, newPos As Long
[COLOR=#006400]'move the item[/COLOR]
    With Me.ListBox1
        If .ListIndex > -1 Then
            newPos = .ListIndex + X
            If newPos < 0 Or newPos = .ListCount Then Exit Sub
            lbVal = .Value
            itms = .List(newPos)
            .List(newPos) = .List(.ListIndex)
            .List(.ListIndex) = itms
        End If
[COLOR=#006400]'re-select original item[/COLOR]
        For i = 0 To .ListCount - 1
            If .List(i) = lbVal Then .Selected(i) = True
        Next i
     End With
End Sub

Amend to suit your needs after testing

If you prefer not to use a spin button, code to move an item up and down

Code:
MoveItem -1
MoveItem 1
 
Last edited:
Upvote 0
Thank Yongle I was able to make this code work to move the list items up and down.

Now I'm just trying to code it to change order of the columns on my sheets. This is what I was thinking.

I have this formula for my column data:
=IFERROR(INDEX('Competitor Comparison Data'!H:H,MATCH($B$3,'Competitor Comparison Data'!$D:$D,0)+ROWS($A$8:$A8)-1),"No Match")
This works great but I think I need to adjust it to make this work. How could this formula be written to also include this logic:

Match the column header on the current sheet with the column header on sheet ("Competitor Comparison Data")

Once that is coded, then I should be able to change the name of the column headers on the current sheet and the data will change.
For example:
Column D has a column header of "Competitor_one" and all the data that corresponds to "Competitor_one" is underneath it. If I replace that header with "Competitor_three", then all the data underneath should now be the data for "Competitor_three"


If that can be coded, then all that needs to be done from there is a code in the listbox that changes the names of the column headers based off the order of the listbox
 
Upvote 0
Match the column header on the current sheet with the column header on sheet ("Competitor Comparison Data")
Have a look at the explanation of how to perform 2-way lookup using Index & Match here
 
Upvote 0
code in the listbox that changes the names of the column headers based off the order of the listbox

Code:
    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
 
Upvote 0
does the same as post#5

Code:
    With Me.ListBox1
        Sheets("NameOfSheet").Range("C2").Resize(, .ListCount).Value = WorksheetFunction.Transpose(.List)
    End With
 
Upvote 0
Thank you all of this. I will let you know how testing goes.

I'm having a very minor issue with my spin button. When I open the userform, only the UP buttons works. When I double click one of my list items, the spin button works fine for both UP and DOWN. How do I make it so the spin button will work properly right when I open the userform?
Code:
Private Sub UserForm_Activate()
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
'*******************
 With ListboxVisible.List
    With SpinButton1
        .Value = 0
        .Max = 1
        .Min = -1
        .SmallChange = 1
    End With
    End With
    End Sub
Private Sub SpinButton1_Change()
    MoveItem -SpinButton1.Value
    SpinButton1.Value = 0
End Sub


Private Sub MoveItem(X As Long)
    Dim itms As String, i As Long, lbVal As String, newPos As Long
'move the item
    With Me.ListboxVisible
        If .ListIndex > -1 Then
            newPos = .ListIndex + X
            If newPos < 0 Or newPos = .ListCount Then Exit Sub
            lbVal = .Value
            itms = .List(newPos)
            .List(newPos) = .List(.ListIndex)
            .List(.ListIndex) = itms
        End If
're-select original item
        For i = 0 To .ListCount - 1
            If .List(i) = lbVal Then .Selected(i) = True
        Next i
     End With
End Sub
 
Upvote 0
I'm having a very minor issue with my spin button etc

The code provided in post#2 works correctly for me
- both UP and DOWN arrows perform as expected

Did you test that code as supplied and did it work for you ?
 
Upvote 0
It worked for me too when I put your code in a blank workbook but I had to adjust your code to my workbook. Instead of animals, I need to use this reference for the list items:
Code:
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

Sidenote, I only need the spin button to work for ListboxVisible, not ListboxHidden.

Here is the entire code that I am working with. The code I adopted from you is in between the asterisks
Code:
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_Activate()
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
'***************************************************
 With ListboxVisible.List
    With SpinButton1
        .Value = 0
        .Max = 1
        .Min = -1
        .SmallChange = 1
    End With
    End With
    End Sub
Private Sub SpinButton1_Change()
    MoveItem -SpinButton1.Value
    SpinButton1.Value = 0
End Sub


Private Sub MoveItem(X As Long)
    Dim itms As String, i As Long, lbVal As String, newPos As Long
'move the item
    With Me.ListboxVisible
        If .ListIndex > -1 Then
            newPos = .ListIndex + X
            If newPos < 0 Or newPos = .ListCount Then Exit Sub
            lbVal = .Value
            itms = .List(newPos)
            .List(newPos) = .List(.ListIndex)
            .List(.ListIndex) = itms
        End If
're-select original item
        For i = 0 To .ListCount - 1
            If .List(i) = lbVal Then .Selected(i) = True
        Next i
     End With
End Sub '***************************************************
 
Upvote 0
Thanks - will investigate when I get a few minutes tomorrow.
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,212
Members
452,618
Latest member
Tam84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top