Sub PopulatingArray()
'Declare the array as a variant array
Dim groupA() As Variant
'Declare the integer to store the number of rows
Dim iRw As Integer
'Assign range to a the array variable
groupA = Range("AA1:AA132")
'loop through the rows - 1 to 10
For iRw = 1 To UBound(groupA)
'show the result in the immediate window
Debug.Print groupA(iRw, 1)
Next iRw
End Sub
For Each person In ListBox2.Items
If (groupA.Contains(People)) Then
MsgBox ("Lets Go")
End If
Next person
Assuming your code is on the userform that contains the listbox, give this a go. A test procedure will run when you open the form.
Option Explicit' not required, but good practice
'Declare the array as a variant array
Dim groupA() As Variant ' mus be before all subs in module
Sub PopulatingArray()
'Declare the integer to store the number of rows
Dim iRw As Integer
'Assign range to a the array variable
groupA = Range("AA1:AA132")
'loop through the rows - 1 to 10
For iRw = 1 To UBound(groupA)
'show the result in the immediate window
Debug.Print groupA(iRw, 1)
Next iRw
End Sub
Sub check_array()
Dim person As Variant
For Each person In ListBox2.List
If contains(groupA, person) Then
MsgBox ("Lets Go " & person)
End If
Next person
End Sub
Function contains(arr As Variant, value As Variant) As Boolean
Dim x As Integer
For x = LBound(arr, 1) To UBound(arr, 1)
If arr(x, 1) = value Then
contains = True
Exit Function
End If
Next
End Function
Private Sub UserForm_Activate()
PopulatingArray
check_array
End Sub
Related
I am looking for the iRow value to be dependent on whether the object value.
I have 2 buttons:
Private Sub OptionButton1_Click()
End Sub
and
Private Sub OptionButton2_Click()
End Sub
If the value of button 1 is True I would like for iRow value to be 2 - for example.
If the value of button 2 is True value would be 3 - for example.
I have tried the below code but it does not seem to work
Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then
iRow = 2
Main code where iRow would need to be dependent on button value.
Private Sub TextBox1_AfterUpdate()
Debug.Print ">AfterUpdate"
Dim ws As Worksheet
Dim iRow As Integer
Dim iCol As Integer
Dim sDate As String
Dim oRange As Range
Set oRange = Nothing
Set ws = Worksheets.Item("Sheet1")
sDate = Format(Now(), "dd/mm/yyyy")
Debug.Print sDate, ws.Name
Set oRange = ws.Range("A:A").Find(DateValue(sDate), , xlValues)
If Not (oRange Is Nothing) Then
iRow = oRange.Row
iCol = 3
ws.Cells(iRow, iCol).Formula = TextBox1.Value
Debug.Print Now(), iRow, iCol, TextBox1.Value
End If
End Sub
Can anyone please help?
Following proposal to solve the issue.
In the Subs OptionButton1_Click()/OptionButton2_Click() rename the Variable, call it differently as the variable you use to check if you are in the correct row in reference to the date. Lets say the variable is called xRow.
Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then
xRow = 1
To make it available in all other Subs, you need to declare it as global/public.
Therefore add into a Module, not in the Code of the forms, following line at the top:
Public xRow As Integer
Finally, just modify your TextBox1_AfterUpdate():
..
If Not (oRange.Row = iRow + xRow) Then
iRow = oRange.Row + xRow
Note: the xRow is the row offset to the 1st found row date match. In the example OptionButton1_Click(), it would enter the input content one row below the 1st date match.
After running the Userform_Initialize() event, there would be nothing populated in the listbox as shown below:
There should be 11 columns populating the listbox based on the excel table below:
The code ran:
Private Sub UserForm_Initialize()
Dim Total_rows_FoilProfile As Long
Dim row As Range, i As Long
Total_rows_FoilProfile = TotalRowsCount(ThisWorkbook.Name, "Foil Profile", "tblFoilProfile")
ReDim MyArr(0 To Total_rows_FoilProfile - 1)
For Each row In ThisWorkbook.Worksheets("Foil Profile").ListObjects("tblFoilProfile").Range.SpecialCells(xlCellTypeVisible).Rows
MyArr(i) = row.Value
i = i + 1
Next row
lbxFoilInfoDisplay.List = MyArr
frmFoilPanel.Show
The properties of the listbox:
You can populate each list row and then add the columns to it:
Option Explicit
Private Sub UserForm_Initialize()
Dim tblFoilProfile As ListObject
Set tblFoilProfile = ThisWorkbook.Worksheets("Foil Profile").ListObjects("tblFoilProfile")
Dim i As Long
lbxFoilInfoDisplay.Clear
Dim iListRow As Range
For Each iListRow In tblFoilProfile.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
With Me.lbxFoilInfoDisplay
.AddItem iListRow.Cells(1, 1).Value 'add first value (column 1)
Dim iCol As Long
For iCol = 2 To iListRow.Columns.Count 'add all other columns to that row
.list(i, iCol) = iListRow.Cells(1, iCol).Value '.Value for unformatted value or .Text to show it in the same format as in the cell
Next iCol
i = i + 1
End With
Next iListRow
End Sub
Note here is a nice guide how to work with list objects.
I know a lot of threads regarding this topic already exist, but I still can't find a solution that works in this scenario. The following two subs keep giving me a "subscript out of range" error.
Sub test1()
Dim Arr() As Variant
Arr= Range("A1:A10")
MsgBox Arr(0)
End Sub
Sub test1()
Dim Arr As Variant
Arr= Range("A1:A10").Value
MsgBox Arr(0)
End Sub
EDITED for clarity, in light of the comments below.
Assigning a range's Value to a Variant variable will either result in the variable containing a one-based 2D array of Variants indexed by row and column (in this order), or containing the actual value of the range if it's a 1-cell range.
In your particular case, this would work:
Sub test1()
Dim Arr As Variant
Dim row As Long
Dim col As Long
row = 1
col = 1
Arr = Range("A1:A10").Value
MsgBox Arr(row, col)
End Sub
In a more general approach, if your downstream code expects to deal with an array, but you range has the possibility to cover a single cell, you can force an array even in such a situation, along those lines:
Sub test2()
Dim rng As Range
Dim Arr As Variant
Dim row As Integer
Dim col As Integer
row = 1
col = 1
Set rng = Range("A1:A1") '<== 1 cell only!
Arr = rng.Value
'Ensure we're dealing with an array even in this case.
If Not IsArray(Arr) Then
ReDim Arr(1 To 1, 1 To 1) As Variant
Arr(1, 1) = rng.Value
End If
MsgBox Arr(row, col)
End Sub
I am trying to create a subroutine to delete duplicates out of comboboxes. I input a number in place of X when I called the subroutine. I keep getting an error that tells me "Object Required" when i get to the subroutine. I know that means that something is not being properly initialized, but I cannot figure out how to fix my issue. Any help would be greatly appreciated. Thank you.
Private Sub UserForm_Initialize()
'ComboBox Populate
Dim rngNext As Range
Dim myRange As Range
Dim C As Integer
With Sheets("KEY")
Set rngNext = .Range("B500").End(xlUp).Offset(1, 0)
End With
rngNext.Select
Set myRange = Range("B2", rngNext)
With ComboBox1
For Each rngNext In myRange
If rngNext <> "" Then .AddItem rngNext
Next rngNext
End With
Call RemoveDuplicates(1)
End sub
Private Sub RemoveDuplicates(X)
'Remove Duplicates
Dim i As Long
Dim j As Long
With "ComboBox" & X
For i = 0 To .ListCount + 1 'Getting object required error in this line
For j = .ListCount To (i + 1) Step -1
If .List(j) = .List(i) Then
.RemoveItem j
End If
Next
Next
End With
End Sub
Final Code
Everything works great for removing duplicates.
Public allCBoxes As Collection
Private Sub UserForm_Initialize()
Set allCBoxes = New Collection
allCBoxes.Add ComboBox1
'ComboBox Populate
Dim rngNext As Range
Dim myRange As Range
Dim C As Integer
With Sheets("KEY")
Set rngNext = .Range("B500").End(xlUp).Offset(1, 0)
End With
rngNext.Select
Set myRange = Range("B2", rngNext)
With ComboBox1
For Each rngNext In myRange
If rngNext <> "" Then .AddItem rngNext
Next rngNext
End With
Call RemoveDuplicates(1)
End sub
Private Sub RemoveDuplicates(X)
'Remove Duplicates
Dim i As Long
Dim j As Long
With allCBoxes(X)
For i = 0 To .ListCount + 1
For j = .ListCount -1 To (i + 1) Step -1
If .List(j) = .List(i) Then
.RemoveItem j
End If
Next
Next
End With
End Sub
You get an error because you're passing a string, not an object.
Although intuitively you can think that:
"ComboBox" & X
will become, for example if x = 5,
ComboBox5
you're wrong because you're actually building a string:
"ComboBox5"
And, clearly, if you call a method of a ComboBox object on a String, you will be prompted of "Object Required".
What you want to do is impossible in VBA, where you cannot define variable names at run-time (i.e. ComboBox & X, even if not "as string", will not reference the variable ComboBox5). To reach what you want, I suggest to create a public collection:
Dim allCBoxes As Collection
then to populate it on the main procedure:
Set allCBoxes = New Collection
allCBoxes.Add ComboBox1
allCboxes.Add ComboBox2
'etc.
and finally recovering the "Xth" combobox like this:
With allCBoxes(X)
End With
If you want to reference a control using its string name, use the Controls function.
Such as:
With Controls("Combobox" & X)
Does that resolve the problem?
As mentioned in my comment above, here's a different approach towards solving the underlying problem: needing a combobox without duplicate values. This method uses a Dictionary object.
Let me know if you can adapt it to your needs, and if it works.
Private Sub UserForm_Initialize()
Dim oDictionary As Object
Dim strCellContent As String
Dim rngComboValues As Range
Dim rngCell As Range
Set rngComboValues = Range("A1:A26")
Set oDictionary = CreateObject("Scripting.Dictionary")
For Each rngCell In rngComboValues
strCellContent = rngCell.Value
If Not oDictionary.exists(strCellContent) Then
oDictionary.Add strCellContent, 0
End If
Next rngCell
For Each itm In oDictionary.keys
Me.ComboBox1.AddItem itm
Next itm
Set oDictionary = Nothing
End Sub
I have been developing a UserForm that uses a listbox populated by the A column to delete specific rows based on listbox selection. But when I click the "Apply" button it takes a ridiculously long time until it processed and deleted the rows.
The code for the Apply button is the following, there is almost no other code in the UserForm. Just Me.Hide in the Cancel button.
Private Sub CommandApply_Click()
Dim i As Long
Dim n As Long
Dim col As New Collection
Dim itm As Variant
Dim rng As Range
' First, collect the row numbers corresponding to the selected items
' We work from last to first
n = Me.ListBox1.ListCount
For i = n - 1 To 0 Step -1
If Me.ListBox1.Selected(i) Then
Else
col.Add i + 1
End If
Next i
' Then delete the rows
Set rng = Worksheets("Sheet1").Range("A1:A100")
For Each itm In col
rng.Rows(itm).EntireRow.Delete
Next itm
blnCancel = False
Me.Hide
End Sub
I think you'd be better off collecting the non-selected items into a Range in your loop and then just deleting that:
Private Sub CommandApply_Click()
Dim i As Long
Dim n As Long
Dim col As New Collection
Dim itm As Variant
Dim rng As Range
' First, collect the row numbers corresponding to the selected items
' We work from last to first
n = Me.ListBox1.ListCount
For i = n - 1 To 0 Step -1
If Not Me.ListBox1.Selected(i) Then
If rng Is Nothing then
Set rng = Worksheets("Sheet1").Range("A" & i + 1)
Else
Set rng = Union(rng, Worksheets("Sheet1").Range("A" & i + 1))
End If
End If
Next i
' Then delete the rows
If not rng Is Nothing then rng.Entirerow.delete
blnCancel = False
Me.Hide
End Sub