Sortable List in VBA? - vba

Is there a way to create a VBA user interface that will allow user to order items? See example image taken from a pdf editor.
I want my users to be able to order data in a popout window or list and output their order to a different location. Data is a list of buildings.
Thanks!

For this solution I used a UserForm with a ListBox and a SpinButton control.
I put a list of cells I wanted in my listbox in Column A of Sheet1. I have a generic Building 1, Building 2, etc. through Building 19 so that my data is contained in the range A1:A19 of Sheet1. This is arbitrary and you should change to suit your needs.
This code basically stores the original RowSource that contains the items in the ListBox, deletes the RowSource from the ListBox, rearranges the underlying source data and then re-applies the RowSource to the ListBox in the new order after the user clicks either up or down on the SpinButton
I did not change the default control names (UserForm1, SpinButton1, ListBox1).
Open the VB Editor (either Developer tab --> Visual Basic or press ALT+F11
Right click Microsoft Excel Objects --> Insert --> UserForm
Add a SpinButton and a ListBox so the UserForm looks like so
In the VB Editor, right click UserForm1 under Forms --> View Code
Paste the following code in
Private Sub UserForm_Initialize()
'Populate the UserForm with data from range A1:A19 (arbitrary, change to suit your needs
ListBox1.RowSource = Sheet1.Range(Sheet1.Range("A1"), Sheet1.Range("A1").End(xlDown)).Address
End Sub
Private Sub SpinButton1_SpinDown()
With ListBox1
If .ListIndex = .ListCount - 1 Then Exit Sub 'No item selected or we are in the last position
lCurrentListIndex = .ListIndex + 1 'Get the current position of the item
strRowSource = .RowSource 'Get the current row source
strAddress = Range(strRowSource).Address 'Address of the row source range
strSheetName = Range(strRowSource).Parent.Name 'Grab the parent sheet name
.RowSource = vbNullString 'Empty the listbox
'Re-arrange the underlying data
With Range(strRowSource)
.Rows(lCurrentListIndex).Cut
.Rows(lCurrentListIndex + 2).Insert Shift:=xlDown
End With
'Re-apply the row source
.RowSource = strRowSource
'For continuity, select the previously selected element in its new position
.Selected(lCurrentListIndex) = True
End With
End Sub
Private Sub SpinButton1_SpinUp()
Dim lCurrentListIndex As Long
Dim strRowSource As String
Dim strAddress As String
Dim strSheetName As String
With ListBox1
If .ListIndex < 1 Then Exit Sub 'No item selected or we are in the first position
lCurrentListIndex = .ListIndex + 1
strRowSource = .RowSource
strAddress = Range(strRowSource).Address
strSheetName = Range(strRowSource).Parent.Name
.RowSource = vbNullString
With Range(strRowSource)
.Rows(lCurrentListIndex).Cut
.Rows(lCurrentListIndex - 1).Insert Shift:=xlDown
End With
.RowSource = strRowSource
.Selected(lCurrentListIndex - 2) = True
End With
End Sub
I tried to add comments to clarify what I am doing. It is a slightly cumbersome method, and was adapted from code available here. If you click the Debug (looks like play) button the form should display and populate with the values of cells A1:A19 of Sheet1. You can then select an item in the ListBox and press the up or down buttons of the SpinButton in order to move items up or down the list. An important assumption is that MultiSelect is disabled on this ListBox.
Ordinarily I would not post such an in-depth solution without seeing what you tried, but this problem piqued my curiosity.

Related

Assign macro to a cell corresponding to the row of automatically generated buttons

I've managed to create a form where the user can expand the fields of a pivot table and, once they've completely expanded a field/branch, a button will appear in column E and that pivot field data is concatenated in column J (there are some hidden columns).
What I want is for the user to click an auto-generating button in column E which exports the corresponding data in column J to a list, somewhere on the workbook.
My code below automatically generates the buttons for fully expanded fields, but I have no idea how to write the code to link each button to the corresponding cell in column J - this is probably not very difficult but any help would be appreciated.
Sub buttonGenerator()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete
Dim t As Range
Dim size As Integer
size = ActiveSheet.PivotTables("Pivottable1").TableRange2.Rows.Count
For i = 2 To size Step 1
If Not IsEmpty(ActiveSheet.Range(Cells(i, 4), Cells(i, 4))) Then
Set t = ActiveSheet.Range(Cells(i, 5), Cells(i, 5))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "btnS"
.Caption = "Add to summary" '& i
.Name = "Btn" & i
End With
End If
Next i
Application.ScreenUpdating = False
End Sub
Sub buttonAppCaller()
MsgBox Application.Caller
End Sub
So here is my code .. it is throwing Runtime error 1004 "Unable to get the Buttons property of the worksheet class". Not sure what I've done wrong but I need to get the data from the cell next to the button to copy over to the bottom of a list in sheet 2 when that particular button is clicked. Please help!
Sub btnS()
Dim dest As Range
Dim origin As Range
origin = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Offset(0, 1) 'input data from cell next to button click
dest = Worksheets("Form Output").Range("A1") 'output data to list in sheet 2 - "Form output"
Set dest = origin
End Sub
Don't use Integer for row counts as you did for size. Excel has more rows than Integer can handle. It is recommended always to use Long instead of Integer in VBA there is no benefit in Integer at all.
The procedure every button invokes is called btnS as you defined in .OnAction = "btnS". Therefore you need a Sub with that name in a Module.
You can use Buttons(Application.Caller).TopLeftCell to get the cell under a button and from that cell you can determine the row or column.
Public Sub btnS() 'sub name must match `.OnAction` name
MsgBox ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
End Sub
Instead of using ActiveSheet I recommend to use a specific worksheet like Worksheets("your-sheet-name") if you plan to use it on a specific sheet only. ActiveSheet can easily change and should be avoided where possible.

VBA excel - adding combo box item to list box

guys I hope someone can help me with this one.
I have a combo box that has data from a named range and I would like to select a value from the combo box and add it to the list box.
Currently I can add an item into the list box with a button but once I add another it overwrites the current item.
Also It needs to be able to add an item at the bottom if the list box already has some values in it.
I think it has something to do with finding the last row but I'm not sure, any help would be highly appreciated :)
image of the issue
Dim i As Integer
With Me.lb_lease
.ColumnCount = 3
.ColumnWidths = "200;50;50"
.AddItem
.List(i, 0) = cbox_hardware.Column(0)
.List(i, 1) = cbox_hardware.Column(1)
.List(i, 2) = cbox_hardware.Column(2)
i = i + 1
End With
I suggest to separate the actions of setting up the listbox and adding items to it. The procedure below will set up the box and clear all existing content. Change the names of the worksheet and the Listbox to match your circumstances. The code will also work if the listbox is in a userform.
Private Sub ResetListBox()
With Worksheets("LibraryAccount").ListBox1
.ColumnCount = 3
.ColumnWidths = "80;50;50"
.Clear ' delete current list
End With
End Sub
The next procedure adds an item to it. It requires a semi-colon separated string, like "One;Two;Three". You might concatenate it from your combobox result using ListIndex to identify the row. The procedure will disassemble the string and add it at the bottom of the list. Worksheet and ListBox names must be changed.
Private Sub AddToListBox(AddArray As String)
Dim Arr() As String
Dim i As Integer
Dim C As Long
Arr = Split(AddArray, ";")
With Worksheets("LibraryAccount").ListBox1
i = .ListCount
.AddItem
For C = 0 To 2
.List(i, C) = Arr(C)
Next C
End With
End Sub
The procedure below is for testing the above procedure. You can run ResetListbox and then call TestAdd several times.
Private Sub TestAdd()
AddToListBox "One;Two;Three"
End Sub

In VBA, why does putting a textbox value into a cell trigger a for loop in another userform subroutine?

I created an userform with 2 textboxes, 3 buttons and a listbox with two columns. If I click on an entry in the listbox, the list entry which is selected gets transfered to two different textboxes.
See the code below:
Private Sub NewSourceListBox_Click()
Dim i As Integer
'Show the selected data in the corresponding text boxes
For i = 0 To NewSourceListBox.ListCount - 1
If NewSourceListBox.Selected(i) Then
'Hide the add button and show the change button
NewSourceBtnChange.Top = 168
NewSourceBtnChange.Visible = True
NewSourceBtnAdd.Visible = False
NewSourcesIDTxtBox.Value = NewSourceListBox.List(i, 0)
NewSourcesSourceTxtBox.Value = NewSourceListBox.List(i, 1)
'Pass on the selected item row to another subroutine
selectedItem = i
Exit For
End If
Next i
End Sub
selectedItem is a global variable created in another module, which I need to use in another subroutine. If I change the entries in the text boxes in the userform and click the change button the following code gets executed.
This code:
Private Sub NewSourceBtnChange_Click()
Dim row As Integer
row = 6257 + selectedItem
'Change the selected data in the list box to the corresponding data in the text boxes
Sheets("Datensätze").Range("A" & row).Value = NewSourcesIDTxtBox.Value
Sheets("Datensätze").Range("B" & row).Value = NewSourcesSourceTxtBox.Value
'Another duplicate entry to make vLookup work
Sheets("Datensätze").Range("C" & row).Value = NewSourcesIDTxtBox.Value
Unload Me
'Unload the new entry user form to repopulate the comboboxes
Unload NewEntryUserForm
NewEntryUserForm.Show
End Sub
If I watch this step by step via F8 then the following happens: As soon as I click the "NewSourceBtnChange" button the corresponding subroutine NewSourceBtnChange_Click() starts. When I reach Sheets("Datensätze").Range("A" & row).Value = NewSourcesIDTxtBox.Value the program jumps to the NewSourcesListBox_Click() routine, executes it two times and jumps back to Sheets("Datensätze").Range("B" & row).Value = NewSourcesSourceTxtBox.Value, then executes the NewSourcesListBox_Click() routine for another two times and jumps back again to the last entry Sheets("Datensätze").Range("C" & row).Value = NewSourcesIDTxtBox.Value and executes the rest of the NewSourceBtnChange_Click() routine.
This makes it impossible to get the new data from the text boxes into their destined cells.
Edit:
Just to make it easier to reconstruct the described behavior, I exported the userform and its code and uploaded it.
Here is what your code is going through (just the important parts):
1) While initializing userform, it populates the listbox with:
.RowSource = "Datensätze!A6257:B" & 6257 + Sheets("Datensätze").Range("F2").Value - 1
2) When you click listbox item, you trigger NewSourceListBox_Click code, populate textboxes with selected items and set item index number to selectedItem variable. (which is handled wrong. You need to declare selectedItem as public variable.)
3) Then you click NewSourceBtnChange which triggers NewSourceBtnChange_Click. It sets row number of your selected item:
row = 6257 + selectedItem
Then you change this very cell using:
Sheets("Datensätze").Range("A" & row).Value = NewSourcesIDTxtBox.Value
which you have used to populate your listbox with:
.RowSource = "Datensätze!A6257:B" & 6257 + Sheets("Datensätze").Range("F2").Value - 1
At this moment, listbox is populated again, but this time it has been already selected so it triggers the NewSourceListBox_Click code.
Whenever you change the RowSource range, if the listbox is selected, it will behave like this. So you need to deselect the listbox item to workaround this.
TL;DR:
After:
row = 6257 + selectedItem
Insert:
NewSourceListBox.Selected(NewSourceListBox.ListIndex) = False
Also to be able to get selectedItem value in other subs, you need to declare it as public variable. Outside of subs, on the very top, insert:
Public selectedItem As Long

Listbox Modification in VBA

I created a Userform in Word which imports 3 columns of data from an excel sheet, inserts it into bookmarks and in the name of the word document and saves it as a pdf.
Now I wanted to add a Listbox into the form to be able to add, modify and delete the inputs manually which are usually imported from the excel sheet .
I already figured out how to add data from 3 textboxes into a 3 Column Listbox but even after googling for hours I can't find a good way to modify selected data.
VB.net has the .selectedItem property, VBA does not. Can anybody give me an example how to modify a multi column listbox with the values of 3 textboxes?
Thanks in advance
You need to iterate through ListBox.Selected and check if it is True. Once you get a True one, you can process that item.
Sample code adds some items with columns and sets up a click event to run through the Selected items.
Private Sub ListBox1_Click()
Dim i As Integer
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Debug.Print ListBox1.List(i, 0)
End If
Next i
End Sub
Private Sub UserForm_Initialize()
ListBox1.AddItem "test"
ListBox1.AddItem "test1"
ListBox1.AddItem "test2"
ListBox1.ColumnCount = 3
ListBox1.ColumnHeads = True
ListBox1.List(1, 0) = "change to 1,0"
ListBox1.List(1, 1) = "change to 1,1"
ListBox1.List(1, 2) = "change to 1,2"
End Sub
Picture of form with Immediate window after clicking each item in turn.

Populating a dropdown box with already-existing options in VBA?

I'm making an add records form for a spreadsheet of mine, and let's say that I want one of the controls to be a dropdown that is populated by unique entries under a certain column "type". However, I want to also make it such that the dropbox always has a initial option to "add new type" and upon such selection, it becomes a regular text box. How would I do this in VBA?
You cannot change a control type at run time. The easiest thing to do is create a combo box and a text box. Set the text box visibility to false. Then in the onchange event of the combo box your code will unhide the text box and hide the combo box. You will also need a save button so that when it is clicked it will add the option to the drop down, clear the text box, hide the text box, hide the button and unhide the drop down.
Okay, so here's my idea of how to tackle this.
Create 2 hidden elements (Visibility = False), one a TextBox and one a CommandButton.
Populate your ComboBox with the values from the sheet under column "type"
Add one more entry AddItem with wording such as "Add new item..."
When the user selects "Add new item...", change the Visibility of the TextBox & CommandButtons to True
When the user clicks the CommandButton, add the phrase to the column and add a new element to the ComboBox
I have created a mockup UserForm and code that does a little more than just this; it also styles the user entry to sentence case (consistency purposes) and checks to make sure the value isn't already in the column.
Excel Sheet with "type" column
UserForm with name labels
UserForm Code
Private Sub bAdd_Click()
Dim str As String
Dim rng As Range
Dim ro As Integer
'Makes sure there is an entry, adds it to the Sheet and then updates the dropdown
If Len(Me.tbNew) > 0 Then
'Converts user entry to "Sentance Case" for better readability
str = StrConv(Me.tbNew, vbProperCase)
'Finds out if the entry already exists
Set rng = Sheets(1).Range(Sheets(1).Cells(2, 1), Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1))
On Error Resume Next
Err.Number = 0
'Searches for duplicate; if found, then ListIndex of cbColor is modified without inserting new value (prevents duplicates)
ro = rng.Find(str, LookIn:=xlValues, LookAt:=xlWhole).Row
Debug.Print Err.Number
'Ensures a user doesn't add the same value twice
If Err.Number > 0 Then
Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row + 1, 1) = str
Me.cbColor.AddItem StrConv(Me.tbNew, vbProperCase), Me.cbColor.ListCount - 1
Me.cbColor.ListIndex = Me.cbColor.ListCount - 2
Else
Me.cbColor.ListIndex = ro - 2
End If
'Resets and hides user form entries
Me.tbNew = vbNullString
Me.tbNew.Visible = False
Me.bAdd.Visible = False
End If
End Sub
Private Sub bClose_Click()
Unload Me
End Sub
Private Sub cbColor_Change()
'Visibility is toggled based on if the user selected the last element in the dropdown
Me.bAdd.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
Me.tbNew.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
End Sub
Private Sub UserForm_Initialize()
'Populate from the sheet
For a = 2 To Sheets(1).Cells(Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1).Row
Me.cbColor.AddItem Sheets(1).Cells(a, 1)
Next
'Add option for new type
Me.cbColor.AddItem "Add new type..."
End Sub