Is it possible to use a listbox to change the order of rows in a worksheet? I have searched the Web for about an hour without ressults. I am using the following code for the task:
Private Sub UserForm_Initialize()
ListBox1.RowSource = "Sheet1!A1:A15"
End Sub
Option Explicit
Const UP As Integer = -1
Const DOWN As Integer = 1
Private Sub SpinButton1_SpinUp()
If Me.ListBox1.ListCount > 1 Then
Call MoveListItem(UP, Me.ListBox1)
End If
End Sub
Private Sub SpinButton1_SpinDown()
If Me.ListBox1.ListCount > 1 Then
Call MoveListItem(DOWN, Me.ListBox1)
End If
End Sub
Private Sub MoveListItem(ByVal intDirection As Integer, _
ByRef ListBox1 As ListBox)
Dim intNewPosition As Integer
Dim strTemp As String
intNewPosition = ListBox1.ListIndex + intDirection
strTemp = ListBox1.List(intNewPosition)
If intNewPosition > -1 _
And intNewPosition < ListBox1.ListCount Then
'Swap listbox items
ListBox1.List(intNewPosition) = ListBox1.Value
ListBox1.List(intNewPosition - intDirection) = strTemp
ListBox1.Selected(intNewPosition) = True
End If
End Sub
Hope somone can give me a hint!
UPDATE!!
What i want is, if I for example have these values in a column in my worksheet:
week1
week2
week3
week4
Then I would like to re-arrenge the order of these values with the SpinButton in the ListBox;
week2
week4
week1
week3
You most certainly can do that!
Here is a quick code that does this in general, I will leave it to you to place this where it is needed:
For i = 0 To ListBox1.ListCount - 1
ActiveWorkbook.Sheets("Sheet1").Range("A" & CStr(i + 1)).Value = ListBox1.List(i)
Next i
You'll probably need to change what is inside the for loop to better reflect your own code. For writing to a specific range just add whatever starting row number you want!
Related
I have been running with this problem for a while, I leave the sample file code, written below, the thing is that when I run it on the computer from where I work at, in the Sub CommandButton1_Click() when it starts to run the 3 lines after the commented line with i=1, each line starts the ListBox1_Click() and resets the textbox values making a mess, how I overcome this?, by using a conditional so it doesn't overwrite anything when working in other functions.
I want to know if anyone had before this problem, and know how to fix it. Running it from my personal computer is not an option, but the if conditional makes the thing, however I don't think is the optimal way to solve the problem.
Private Sub CommandButton1_Click()
Dim Ultima_Fila As Integer
Ultima_Fila = Sheets("Sheet1").Range("E2") + 1
Sheets("Sheet1").Range("A" & Ultima_Fila).EntireRow.Insert
Sheets("Sheet1").Range("A" & Ultima_Fila) = Sheets("Sheet1").Range("E2")
'i=1 'Required i to be 1 in order to avoid the code to jump and read the textbox from the ListBox1_Click
Sheets("Sheet1").Range("B" & Ultima_Fila) = TextBox1.Value
Sheets("Sheet1").Range("C" & Ultima_Fila) = TextBox2.Value
Sheets("Sheet1").Range("D" & Ultima_Fila) = TextBox3.Value
'i=0 Restarts i value
End Sub
Private Sub ListBox1_Click()
'If i = 0 Then 'When the sub is initialized directly from the listbox click it stores the values displayed on the textboxes
TextBox1 = ListBox1.List(ListBox1.ListIndex, 1)
TextBox2 = ListBox1.List(ListBox1.ListIndex, 2)
TextBox3 = ListBox1.List(ListBox1.ListIndex, 3)
'End If 'This conditional jumps the following instruction when it is reached from the CommandButton1_Click
End Sub
Private Sub UserForm_Activate()
With ListBox1
.ColumnCount = 4
.RowSource = "Table1"
.ColumnHeads = True
End With
End Sub
Please don't be disheartened by the changes I made to your code. In essence it remains the same. I just wanted to be sure that what I tell you is 100% correct:-
The ListBox1_Click event is triggered by a change to ListBox1.ListIndex. My code below contains such a change and disables the event it causes in the way you already found. The explanation for the procedure being fired on another computer is that the ListIndex is changed. Perhaps the code being run there is different and perhaps it's a Mac or Google sheets, in short, a non-Microsoft engine interpreting the same code.
However, you may still like my code because it has some features that yours didn't have. Please try it. It should run on both systems.
Option Explicit
Private DisableListBoxEvents As Boolean
Private Sub UserForm_Activate()
' 263
With ListBox1
.ColumnCount = 4
.RowSource = "Table1"
.ColumnHeads = True
End With
End Sub
Private Sub CommandButton1_Click()
' 263
Dim Ultima_Fila As Integer
Dim Tbx As Control
Dim i As Integer
With Worksheets("Sheet1")
Ultima_Fila = .Range("E2").Value + 1
With .ListObjects(1)
' inserts a table row before table row Ultima_Fila
' Omit the number to append a row.
' To convert sheet row to table row enable this line:-
' Ultima_Fila = Ultima_Fila - .Range.Row - 1
With .ListRows.Add(Ultima_Fila).Range
For i = 1 To 3
Set Tbx = Me.Controls("TextBox" & i)
.Cells(i + 1).Value = Tbx.Value
Tbx.Value = ""
Next i
End With
End With
End With
With ListBox1
DisableListBoxEvents = True
.RowSource = "Table1"
.ListIndex = -1
DisableListBoxEvents = False
End With
End Sub
Private Sub ListBox1_Click()
' 263
Dim i As Integer
If DisableListBoxEvents Then Exit Sub
With ListBox1
For i = 1 To 3
Me.Controls("TextBox" & i).Value = .List(.ListIndex, i)
Next i
End With
End Sub
I create listbox in excel with VBA userform. Its values are obtained from the Sheet in Excel.
How can I delete the values in the sheet "database" while deleting the box list item?
please help me.
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim rng As Range
Dim MyArray
Set ws = Sheets("Database")
Set rng = ws.Range("K2:L" & ws.Range("K" & ws.Rows.Count).End(xlUp).Row)
With Me.ListBox1
.Clear
.ColumnHeads = False
.ColumnCount = rng.Columns.Count
MyArray = rng
.List = MyArray
.ColumnWidths = "90;90"
.TopIndex = 0
End With
End Sub
Private Sub CommandButton2_Click()
For lItem = Me.ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(lItem) Then
ListBox1.RemoveItem lItem
If Me.ListBox1.MultiSelect = fmMultiSelectSingle Then
Exit For
End If
End If
Next
End Sub
How do I delete the values in the sheet "database"?
As you assign database items via the array method (not using ControlSource), you want to know how to synchronize listbox items with your data base after manual deletion.
Approach A) - Write the entire Listbox1.List
If you want a mirror image of the listbox items after the For- Next loop, you could simply write these items back to a given range (of course you should clear 'surplus rows', too) via the following one liner
rng.Resize(Me.ListBox1.ListCount, 2) = Me.ListBox1.List
Instead of reduplicating the data range declaration in CommandButton2_Click, I'd suggest to declare it ONCE in the declaration head of the Userform code module (and omit it in Userform_Initialize):
Thus the complete code would be as follows:
â–ºAdditional notes due to comment
Insert these two code lines on top of your UserForm code module (and before any procedures).
Option Explicit is strictly recommended in any code to force the declaration of variable types (but you can't use this statement within a Sub as you did). The declaration Dim rng As Range OUTSIDE the other procedures (i.e. on top) allows that any procedure within this code module knows the rng variable.
Option Explicit ' declaration head of the UserForm module
Dim rng as Range ' ONE database declaration only!
' << OUTSIDE of following procedures
' << Start of regular procedures
Private Sub UserForm_Initialize()
Dim ws As Worksheet
' Dim rng As Range ' << not needed here, see top declaration
Dim MyArray
Set ws = Sheets("Database")
Set rng = ws.Range("K2:L" & ws.Range("K" & ws.Rows.Count).End(xlUp).Row)
With Me.ListBox1
.Clear
.ColumnHeads = False
.ColumnCount = rng.Columns.Count
MyArray = rng
.List = MyArray
.ColumnWidths = "90;90"
.TopIndex = 0
End With
End Sub
Private Sub CommandButton3_Click()
Dim lItem&
For lItem = Me.ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(lItem) Then
ListBox1.RemoveItem lItem ' remove item from listbox
If Me.ListBox1.MultiSelect = fmMultiSelectSingle Then
Exit For
End If
End If
Next
rng.Offset(Me.ListBox1.ListCount, 0).Resize(rng.Rows.Count, 2) = "" ' clear rows
rng.Resize(Me.ListBox1.ListCount, 2) = Me.ListBox1.List ' write list back
End Sub
Note that no rows are deleted physically, the resulting listbox items in the two target columns K:L are shifted up only (approach B allows to delete entire rows as well).
Approach B) - Help procedure within main loop
Using the same data range declaration in the declaration head of the UserForm â–º as shown above (i.e. OUTSIDE the procedures as Subs or Functions), you could use a help procedure DelData allowing to distinguish between two principal cases:
[1] Shift up deleted cells in your database
[2] Delete the entire row
Event procedure CommandButton2_Click
Private Sub CommandButton2_Click()
' Purpose: delete items both from database and listbox
Dim lItem&
For lItem = Me.ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(lItem) Then
DelData lItem, True ' [1] True=delete items and shift up
'DelData lItem, False ' [2] False=delete entire row
ListBox1.RemoveItem lItem ' remove item from listbox
If Me.ListBox1.MultiSelect = fmMultiSelectSingle Then
Exit For ' do it once in single select case
End If
End If
Next
End Sub
Help procedure DelData
Sub DelData(ByVal indx&, Optional ByVal bShiftUp As Boolean = True)
' Purpose: delete indicated row items in database
' Note: data set in OP includes header
If bShiftUp Then ' [1] bShiftUp = True: delete row items and shift up
rng.Offset(indx).Resize(1, rng.Columns.Count).Delete xlShiftUp
Else ' [2] bShiftUp = False: delete entire row of indicated items
rng.Offset(indx).Resize(1, rng.Columns.Count).EntireRow.Delete
End If
End Sub
Side note
It's recommended to fully qualify range references to avoid getting data from wrong workbooks, so I'd suggest the following statement in your UserForm_Initialize procedure:
Set ws = ThisWorkbook.Worksheets("Database")
Enjoy it :-)
Before removing the item from the ListBox you need to use the located value at the ListBox.Selected to find and remove the item from your "database".
Something like this:
Private Sub CommandButton2_Click()
For lItem = Me.ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(lItem) Then
DeleteItemFromDatabase ListBox1.Selected(lItem).Value
ListBox1.RemoveItem lItem
If Me.ListBox1.MultiSelect = fmMultiSelectSingle Then
Exit For
End If
End If
Next
End Sub
Then your Sub DeleteItemFromDatabase(ByVal itemToDelete As [type]) would find itemToDelete in your "database" and remove it.
As an additional note, you may want to consider using Access as your database since it's actually designed to be one. I realize this isn't always possible, but thought I'd throw it out there as a thought for you.
I need some help with getting the right code to do the following:
I have 4 groups of radio buttons inside a frame in a userform
Each group is a simple Yes/No radio button
I have a textbox that I want to autofill with a score range of A-D depending on the # of "yes" radio buttons selected.
The "No" checkboxes really shouldn't do anything in regards to the textbox
Userform Name = TP_UF
Frame Name = fun_opt_frame
Option Button Name for "Yes" = fun_score_yes1-4
Textbox Name = fun_scorebox
Logic:
4 Yesses = A
3 Yesses = B
2 Yesses = C
1 Yes = D
It doesn't matter what order the yesses are selected, its a total count. I tried using code using the frame but not sure if that is the best way. The frame for these radio buttons isn't needed for any reason other then to perhaps make it easier to code. So I could throw out the frame if it's not necessary to get this working.
I am not sure where to start here. Any help would be appreciated.
pic
The quickest and easiest way for you to understand is - I guess - the following code. You have to put the code into the class module of the userform.
Option Explicit
Dim opt1 As Byte
Dim opt2 As Byte
Dim opt3 As Byte
Dim opt4 As Byte
Private Sub opt1Yes_Click()
opt1 = 1
EvalOpt
End Sub
Private Sub opt1No_Click()
opt1 = 0
EvalOpt
End Sub
Private Sub opt2yes_Click()
opt2 = 1
EvalOpt
End Sub
Private Sub opt2No_Click()
opt2 = 0
EvalOpt
End Sub
Private Sub opt3yes_Click()
opt3 = 1
EvalOpt
End Sub
Private Sub opt3No_Click()
opt3 = 0
EvalOpt
End Sub
Private Sub opt4yes_Click()
opt4 = 1
EvalOpt
End Sub
Private Sub opt4No_Click()
opt4 = 0
EvalOpt
End Sub
Private Sub EvalOpt()
Dim sumOpt As Byte
Dim res As String
sumOpt = opt1 + opt2 + opt3 + opt4
Select Case sumOpt
Case 1: res = "D"
Case 2: res = "C"
Case 3: res = "B"
Case 4: res = "A"
Case Else: res = ""
End Select
Me.fun_scorebox.text = res
End Sub
I assumed the option buttons are named opt1Yes, opt1No, opt2Yes, opt2No etc.
A more advanced solution would probably be to use classe modules and "collect" the option buttons in such a way.
I ended up going about this differently and I got it working using a counter. Thanks for the help! Posting code here in case anyone else needs it.
Option Explicit
Private Sub OptionButton1_Change()
set_counter
End Sub
Private Sub OptionButton2_Change()
set_counter
End Sub
Private Sub OptionButton3_Change()
set_counter
End Sub
Private Sub OptionButton4_Change()
set_counter
End Sub
Private Sub OptionButton5_Change()
set_counter
End Sub
Private Sub OptionButton6_Change()
set_counter
End Sub
Private Sub OptionButton7_Change()
set_counter
End Sub
Private Sub OptionButton8_Change()
set_counter
End Sub
Private Sub set_counter()
Dim x As Integer, counter As Integer
Me.TextBox1.Value = ""
counter = 0
For x = 1 To 8 Step 2
If Me.Controls("OptionButton" & x).Value = True Then counter = counter + 1
Next x
Me.TextBox1.Value = Choose(counter, "D", "C", "B", "A")
End Sub
Private Sub UserForm_Activate()
Me.TextBox1.Value = ""
End Sub
Private Sub UserForm_Click()
Dim x As Integer
Me.TextBox1.Value = ""
For x = 1 To 8
Me.Controls("OptionButton" & x).Value = False
Next x
End Sub
The idea was to create a variable that would save the changes made to it from previous use of the macro. I have a userform that pulls values from a range and populates unique values in a listbox. I then want to be able to add selected values to my dictionary/collection and save the change. Once all necessary changes have been made, the macro should use the dictionary variable as criteria for an autofilter.
My question is two fold, what class should I use to accomplish this? How can a use this variable to autofilter my worksheet? Userform code is below:
The First bit of code is for the "Add" command button. It is supposed to take the selected value(s) in the listbox and add them to the dictionary titled "Market". The code after that pulls the values from a recently opened excel workbook an displays unique values in the listbox. Listbox2 holds all previous values from past uses of the macro. I want to add a "Delete" button to the userform to tidy up the list if necessary. The two public variables below are actually located on the main macro module, this would allow me to store the values in the dictionary after the userform has stopped running.
Private Sub CommandButton1_Click()
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Market.Add ListBox1.List(i)
Set Market = New Collection
End If
Next
End Sub
Private Sub UserForm_Initialize()
Dim myList As Collection
Dim myRange As Range
Dim ws As Worksheet
Dim myVal As Variant
Dim Col As Integer
Set ws = ActiveWorkbook.Sheets("Daily Unconfirmed")
Col = WorksheetFunction.Match("Marketer", ws.Range("3:3"), 0)
Set myRange = ws.Range(Cells(4, Col), Cells(4, Col).End(xlDown))
Set myList = New Collection
On Error Resume Next
For Each mycell In myRange.Cells
myList.Add mycell.Value, CStr(mycell.Value)
Next mycell
On Error GoTo 0
For Each myVal In myList
Me.ListBox1.AddItem myVal
Next myVal
Public item As Variant
Public Market As Collection
Market.Add "Al D"
Market.Add "B Collins"
Market.Add "B G"
Market.Add "C Huter"
For Each item In Market
Me.ListBox2.AddItem item
Next item
End Sub
Since AutoFilter runs from an array, I would build the array dynamically and use it in a filtering sub:
Dim ary()
Sub MAIN()
Call BuildDynamicArray
Call FilterMyData
End Sub
Sub BuildDynamicArray()
Dim inString As String
i = 1
While 1 = 1
x = Application.InputBox(Prompt:="Enter a value", Type:=2)
If x = False Then GoTo out
ReDim Preserve ary(1 To i)
ary(i) = x
i = i + 1
Wend
out:
End Sub
Sub FilterMyData()
ActiveSheet.Range("$A$1:$A$10").AutoFilter Field:=1, Criteria1:=ary, Operator:=xlFilterValues
End Sub
I am using the code below to make navigation through workbook easier. However, after running the macro cursor movement is odd (restricted range and jumping). In addition the workbook does not close when clicking on the red "x" to close the window. Further, the group and ungroup icons (for hiding or expanding rows and columns) does not work. It appears that somehow "control" is still in VBA as supposed to normal Excel. All help seriously appreciated.
Userform code:
Option Explicit
Option Base 1
Private Sub UserForm_Initialize()
Dim ShList()
Dim ShCount As Integer
Dim x As Integer
Dim ListPos As Integer
ShCount = ActiveWorkbook.Sheets.Count
ReDim Preserve ShList(1 To ShCount)
For x = 1 To ShCount
If Sheets(x).Name = ActiveSheet.Name Then
ListPos = x - 1
End If
ShList(x) = Sheets(x).Name
Next x
With ListBox1
.List = ShList
.ListIndex = ListPos
End With
End Sub
Private Sub CommandButton1_Click()
Sheets(ListBox1.Value).Activate
Unload UserForm1
End Sub
Click button to activate code:
Option Explicit
Sub WorksheetSelect_Click()
UserForm1.Show
End Sub
I had the same issue and had to remove the following code:
Sheets(1).Activate
After removing it, I was able to close the Excel as always.
I had the same problem. It was solved by changing any cell value in any cell on the active worksheet as last row in my VBA code. In my case I added the VBA code: Range("A1") = "_", but you could also change any other cell to any other value.
sorry not using comment, because its too long, just analyzing your code
Option Explicit
Option Base 1 'someone tell me what's this ? i might be noob at this point
Private Sub UserForm_Initialize()
Dim ShList() 'as variant
Dim ShCount As Integer 'as Long
Dim x As Integer 'as long
Dim ListPos As Integer 'as Long
ShCount = ActiveWorkbook.Sheets.Count
ReDim Preserve ShList(1 To ShCount) 'remove preserve
For x = 1 To ShCount
If Sheets(x).Name = ActiveSheet.Name Then
ListPos = x - 1
End If
ShList(x) = Sheets(x).Name
Next x
With ListBox1 'i usually write : with Me.Listbox1, but i guess its ok
.List = ShList
.ListIndex = ListPos
End With
'add erase ShList (free memory)
End Sub
so main thing, remove Preserve, and add a Erase for your Array