So, I have a form that I'm trying to populate the ComboBox with an Array that should be full of elements based on a loop. However when I'm attempting to initialize the form and populate the ComboBox I'm getting a Subscript out of Range Error
I'm not really sure why I'm running out of the range so I could use some help examining my code. I'm not the most familiar with VBA so I could really use a second set of eyes to tell me what I'm doing wrong.
Private Sub UserForm_Initialize()
Dim refConcentrations As Variant
Dim i As Long, j As Integer, LRow As Long
With Sheets(2)
LRow = .Cells(.Rows.Count, "E").End(xlUp).row + 1
End With
ReDim refConcentrations(1 To LRow) As Variant
j = 1
For i = 2 To LRow
'Check if Current Session User is equal to any of the Stored ECNs
If Sheets(2).Range("A" & i) = VBA.Environ("UserName") Then
'If So, Store that ECN in Array
refConcentrations(j) = Sheets(2).Range("E" & i).Value
j = j + 1
End If
Next i
ReDim Preserve refConcentrations(1 To j - 1) ' <-- resize array to number of elements found
ComboBox_PreviousECN.List = refConcentrations() ' <-- Set ComboBox Dropdown to equal the elements in the Array
End Sub
Adding () to the name of an array tells the compiler to look for an index.
The notation used to refer to an element of an array consists of the variable name followed by parentheses containing an index number indicating the desired element.
The Error 9: Subscript out of range error is thrown because:
You referenced a nonexistent array element.
that is, the null element called by ().
The VBA reference on the List property of the ComboBox element says:
Use List to copy an entire two-dimensional array of values to a control.
Similarly:
a = Array(1, 2, 3, 4)
For Each x In a
Debug.Print x 'works
Next x
Debug.Print a 'throws an error
Debug.Print a() 'throws an error
Debug.Print a(0) 'returns 1
Ref:
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/array-function
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/subscript-out-of-range-error-9
https://learn.microsoft.com/en-us/office/vba/api/outlook.combobox.list
Related
For each line of the selected listbox I want to insert data in the next blank row for every data selected in the listbox, one new copied row, but the text that comes from the Textbox must be copied equal in all row, the below code copied the text only in one single row
Private sub button1_click()
Dim rw as integer
Dim ws as worksheets
Set worksheets(“Sheet1”)
Rw = ws.cells.find(what:=“*”, searchorder:=xlrows, searchdirection:=xlprevious, lookin:xlvalues).row + 1
Ws.cells(rw, 3).value = me.textbox1.value
Ws.cells(rw, 5).value = me.listbox1.value
End sub
Please help me 😊
I've created a new Workbook and a new UserForm with a ListBox, TextBox and CommandButton all with default names for this example.
Option Explicit
____________________________________________________________________________________
Private Sub CommandButton1_Click()
Dim NextBlankRow As Long
Dim TargetRange As Range
Dim ListBoxItem As Long
Dim SelectedItemsArray As Variant
Dim ArrayElementCounter As Long
ArrayElementCounter = 0
With Me.ListBox1
ReDim SelectedItemsArray(0 To .ListCount - 1)
For ListBoxItem = 0 To .ListCount - 1
If .Selected(ListBoxItem) Then
SelectedItemsArray(ArrayElementCounter) = .List(ListBoxItem)
ArrayElementCounter = ArrayElementCounter + 1
End If
Next ListBoxItem
End With
ReDim Preserve SelectedItemsArray(0 To ArrayElementCounter - 1)
With ThisWorkbook.Sheets("Sheet1")
NextBlankRow = .Cells(Rows.Count, 3).End(xlUp).Row + 1
Set TargetRange = .Range("C" & NextBlankRow & ":C" & NextBlankRow + UBound(SelectedItemsArray))
End With
Dim TargetCell As Range
ArrayElementCounter = 0
For Each TargetCell In TargetRange
TargetCell.Value = Me.TextBox1.Value
TargetCell.Offset(0, 2).Value = SelectedItemsArray(ArrayElementCounter)
ArrayElementCounter = ArrayElementCounter + 1
Next TargetCell
End Sub
____________________________________________________________________________________
Private Sub UserForm_Initialize()
Dim ListBoxItemArray As Variant
ListBoxItemArray = Array("Listbox Item 1", "Listbox Item 2", "Listbox Item 3")
Dim ItemToAdd As Long
For ItemToAdd = LBound(ListBoxItemArray) To UBound(ListBoxItemArray)
Me.ListBox1.AddItem (ListBoxItemArray(ItemToAdd))
Next ItemToAdd
End Sub
Here are screenshots of the inputs and outputs:
Data selected/entered to the UserForm
[
Output to the worksheet
Explanation:
The Private Sub UserForm_Initialize() event populates the ListBox for the purposes of my example - You can ignore this when it comes to your code but I felt it necessary to include how I populated the ListBox Items and what values with.
The Private Sub CommandButton1_Click() event code breaks down into 4 main sections (starting after the variables are declared):
With Me.LisBox1...End With
The very first thing we do here is set the Array size with the ReDim statement. The UpperBound or limit of the Array is set to the ListCount property minus 1 which returns 1 less the number of items in the ListBox. This ensures our Array is big enough to hold all of the list box items values, if they were all selected for example, but does so dynamically so you don't waste memory using an ambiguous number to future proof your code like 100 when you might only have 30 items. If Items are added or removed, the Array is always the right size.
The reason we minus 1 is I declared the Option Base to 0 for the Array which means it starts at (or the Lower Bound is) 0 not at 1. See the Option Base Statement for more info.
Next we loop through each ListBox item and evaluate if it is Selected or not. If it is, we use the List() property to assign the value of that item to the Array. See For...Next loops for more info on how they work and see Using Arrays for how they work.
Now we have SelectedItemsArray() full of the values for each selected item in the listbox.
ReDim Preserve SelectedItemsArray(0 To ArrayElementCounter - 1)
Much like earlier, we are setting the size of our array but this time including the Preserve part of the statement. This means we can resize the array but keep all the current values in it - If we didn't use Preserve the Array would be resized but lose all values. We again set the Upper Bound dynamically to resize the array to the number of selected items. (See the Using Arrays info again regarding array sizes etc.)
With ThisWorkbook.Sheets("Sheet1")...End With
In this With block we are finding the last used row of Column C and assigning that row + 1 (so it references the next blank row) to LastUsedRow. We are also defining our range we want to write our data to dynamically using the LastUsedRow variable and the Upper Bound of our Array. This is done so the right amount of cells are written to in the next section of code.
For Each TargetCell In TargetRange...Next TargetCell
Another loop but this time For Each...Next is used. Very similar to the For...Next loop but this one loops through elements of an array or collection - in this case we will be looping through each cell in our TargetRange.
For each cell in the range, remembering our range is set to Column C from the next blank row, The TextBox value is written to Column C and each ListBox item value from our array is written to Column E. As the loop iterates, the ArrayItemCounter increments which ensures the next array element is written to Column E with each loop.
I have the first name in column A and the last name in Column B and I need to combine them into just column A. Also not sure if I need to check this in the code but some of the cells are empty with now names. I have tried many things but they all want me to pull the two and enter them into a different or 3rd column. But I need to put them into column A.
This is the code I have and it keeps giving me the merge error.
With Worksheet
For Counter = LastRow To FirstRow Step -1
Range("BD2:BE1000").Merge Across:=True
Next Counter
End With
You can just use string concatenation here (assuming that lastrow (1000) and firstrow (2) have been set up properly in your sample code).
With Worksheet
For Counter = LastRow To FirstRow Step -1
.Range("BD" & counter).Value = .Range("BD" & counter).value & .Range("BE" & counter).value
Next Counter
End With
Concatenate (non-empty) names into one column
[1] In a first step you can assign your data range (object variable e.g. rng) to a variant 1-based 2-dim datafield array by a one liner v = rng or v = rng.Value2.
[2] In a second step you loop through all array rows and check for non-empty names concatenating these findings in the array's first columns (overwriting the original single name part).
[3] Resizing the receiving range to 1 column only (and the number of non-empty rows allows you to write the results back to sheet.
Code example
Option Explicit ' declaration head of your code module enforces declaration of variables/objects
Sub ConcatenateNames()
Dim v As Variant, rng As Range
With ThisWorkbook.Worksheets("MySheet") ' <<~~ change to your sheet name
' [1] assign names to 2-dim datafield array v
Set rng = .Range("BD2:BE1000") ' set user defined range to memory
v = rng.Value2 ' get data
' [2] loop through data
Dim i As Long, ii As Long
For i = 1 To UBound(v)
' [2a] check for non empty names
If Len(Trim(v(i, 1)) & Trim(v(i, 2))) > 0 Then
' [2b] concatenate first and last names in array v
ii = ii + 1 ' increment counter
v(ii, 1) = v(i, 1) & " " & v(i, 2)
End If
Next i
' [3] write back to sheet and resize receiving range to ii rows and 1 column
rng.Clear ' clear original data
rng.Resize(ii, 1) = v ' write names back to sheet
End With
End Sub
Further hint
Take care of the leading point . before "Range" referring to your worksheet object: Set rng = .Range("BD2:BE1000")
I'm trying to delete all rows on my worksheet that have a unique value in column B.
I know this can be done with a filter or conditioned formatting, but I would like to know if the following is possible as well, since it could be useful in other situations:
I want to loop through all rows and store the row number in an Array if the row has a unique value in column B. Then delete all the rows whose number is stored in the Array in one single action.
The reasoning for storing the row numbers in an Array instead of deleting the desired rows in the loop is to reduce runtime.
My data varies in number of rows but is always in column A:K and it always begins on row 6.
Below is the code I've written with inspiration from the following links:
Dynamically adding values to the array on the go.
Deleting rows whose number is stored in array in one single action (see Tim Williams answer).
I get the error message: Run-time error '5': Invalid procedure call or Argument
Sub DeleteRows()
Dim ws4 As Worksheet: Set ws4 = Worksheets("Sheet1")
Dim LastRow As Long
Dim CurrentRow As Long
Dim GroupValue
Dim GroupTotal As Long
Dim MyArray()
Dim y As Long
Application.ScreenUpdating = False
ws4.Activate
GroupValue = ws4.Range("B6").Value ' Sets the first GroupValue
CurrentRow = 6 ' Sets the starting row
y = 0
LastRow = ws4.Cells(Rows.Count, "B").End(xlUp).Row
For x = 1 To LastRow
GroupTotal=Application.WorksheetFunction.CountIf(Range("B6:B"&LastRow), _
GroupValue) ' Searches for the GroupValue and finds number of matches
If GroupTotal = 1 Then ' If GroupTotal = 1 then add the row# to the array
ReDim Preserve MyArray(y)
MyArray(y) = CurrentRow
y = y + 1
End If
CurrentRow = CurrentRow + GroupTotal 'set the next row to work with
GroupValue = Range("B" & CurrentRow).Value 'set next GroupValue to find
If GroupValue = "" Then ' Checks to see if the loop can stop
Exit For
End If
Next x
'***This should delete all the desired rows but instead produces the error.***
ws4.Range("B" & Join(MyArray, ",B")).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
I've researched for hours and tried to manipulate the code with no luck.
Use a variable defined as a Range and Union each row to it.
In the example below MyArray is the array of row numbers that should be deleted.
Public Sub Test()
Dim MyArray() As Variant
MyArray = Array(2, 4, 5, 8, 10, 15)
DeleteRows MyArray
End Sub
Public Sub DeleteRows(RowNumbers As Variant, Optional SheetName As String = "")
Dim wrkSht As Worksheet
Dim rRange As Range
Dim x As Long
On Error GoTo ERROR_HANDLER
If SheetName = "" Then
Set wrkSht = ActiveSheet
Else
Set wrkSht = ThisWorkbook.Worksheets(SheetName)
End If
For x = LBound(RowNumbers) To UBound(RowNumbers)
If rRange Is Nothing Then
Set rRange = wrkSht.Rows(RowNumbers(x))
Else
Set rRange = Union(rRange, wrkSht.Rows(RowNumbers(x)))
End If
Next x
If Not rRange Is Nothing Then rRange.Delete
On Error GoTo 0
Exit Sub
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure DeleteColumns."
Err.Clear
Application.EnableEvents = True
End Select
End Sub
Edit
The Test procedure can be replaced with any code that creates an array of row numbers. The array is then passed to the DeleteRows procedure. You could also pass it a sheet name to delete the rows from: DeleteRows MyArray, "Sheet2".
The DeleteRows procedure sets up the variables, turns error checking on and then checks if a sheet name was passed to it. It then sets a reference to either the active sheet or the named sheet. You could also check if the passed sheet actually exists here.
Next a loop starts going from the first to last element of the array. The first is usually 0 so you could replace LBOUND(RowNumbers) with 0.
rRange is the variable that's going to hold the row references to delete and Union won't work if it doesn't already hold a range reference.
On the first pass of the loop it won't hold a reference so will be nothing and the first row in the array will be set as the first row reference on the sheet held in wrkSht.
On subsequent passes rRange will already hold a reference so the next row will be unioned to it.
Those two decisions are made in an IF...END IF block seperated by an ELSE statement.
After the loop has finished a single line IF statement - no END IF required on single line - checks if rRange holds any references. If it does then those rows are deleted.
The procedure exits the main body of code, deals with the error handling and then ends.
I am trying to find a way to:
Loop through a column (B column)
Take the values, store them in an array
Loop through that array and do some text manipulation
However, I cannot think of a way to loop through a column and take those values, storing them in an array. I have looked through Stack Overflow and google but have not found a successful solution.
In advance, thank you for your help.
Sub collectNums()
Dim eNumStorage() As String ' initial storage array to take values
Dim i as Integer
Dim j as Integer
Dim lrow As Integer
lrow = Cells(Rows.Count, "B").End(xlUp).Row ' The amount of stuff in the column
For i = lrow To 2 Step -1
If (Not IsEmpty(Cells(i, 2).Value)) Then ' checks to make sure the value isn't empty
i = eNumStorage ' I know this isn't right
Next i
If (IsEmpty(eNumStorage)) Then
MsgBox ("You did not enter an employee number for which to query our database. Quitting")
Exit Sub
End If
End Sub
This is the easiest way to get column to array:
Public Sub TestMe()
Dim myArray As Variant
Dim cnt As Long
myArray = Application.Transpose(Range("B1:B10"))
For cnt = LBound(myArray) To UBound(myArray)
myArray(cnt) = myArray(cnt) & "something"
Next cnt
For cnt = LBound(myArray) To UBound(myArray)
Debug.Print myArray(cnt)
Next cnt
End Sub
It takes the values from B1 to B10 in array and it gives possibility to add "something" to this array.
The Transpose() function takes the single column range and stores it as an array with one dimension. If the array was on a single row, then you would have needed a double transpose, to make it a single dimension array:
With Application
myArray = .Transpose(.Transpose(Range("A1:K1")))
End With
MSDN Transpose
CPearson Range To Array
Creating an Array from a Range in VBA
Just adding a variation on Vityata's which is the simplest way. This method will only add non-blank values to your array. When using your method you must declare the size of the array using Redim.
Sub collectNums()
Dim eNumStorage() As String ' initial storage array to take values
Dim i As Long
Dim j As Long
Dim lrow As Long
lrow = Cells(Rows.Count, "B").End(xlUp).Row ' The amount of stuff in the column
ReDim eNumStorage(1 To lrow - 1)
For i = lrow To 2 Step -1
If (Not IsEmpty(Cells(i, 2).Value)) Then ' checks to make sure the value isn't empty
j = j + 1
eNumStorage(j) = Cells(i, 2).Value
End If
Next i
ReDim Preserve eNumStorage(1 To j)
'Not sure what this bit is doing so have left as is
If (IsEmpty(eNumStorage)) Then
MsgBox ("You did not enter an employee number for which to query our database. Quitting")
Exit Sub
End If
For j = LBound(eNumStorage) To UBound(eNumStorage) ' loop through the previous array
eNumStorage(j) = Replace(eNumStorage(j), " ", "")
eNumStorage(j) = Replace(eNumStorage(j), ",", "")
Next j
End Sub
I have been working on this particular problem for sometime and am obviously missing something very simple. I ma trying to create an aray based on a dynamic range in Excel and using the individual elements to compare against another array. The only problem with the attached code is it continues to show empty elements. Any guidance would be appreciated.
Part of my overall code attached.
Sub Test_Again()
Dim R As Long
Dim C As Long
Dim List() As Variant
Dim i As Integer
List = Sheets("Sheet11").Range("A2:A17").Value
For R = 1 To UBound(List, 1) ' First array dimension is rows.
For C = 1 To UBound(List, 2) ' Second array dimension is columns.
Debug.Print List(R, C)
Next C
Next R
ReDim List(UBound(List, 1))
Do Until i = UBound(List)
If List(i) = Now() Then
End If
i = i + 1
Loop
End Sub
The normal Redim will clear your array - unless you use Redim Preserve. However, according to the help:
If you use the Preserve keyword, you can resize only the last array dimension and you can't change the number of dimensions at all. For example, if your array has only one dimension, you can resize that dimension because it is the last and only dimension. However, if your array has two or more dimensions, you can change the size of only the last dimension and still preserve the contents of the array.
Therefore, in your case Redim will not help you here. If you want to transfer a two dimensional array to a one dimensional array, you need to do this manually instead:
Sub Test_New()
Dim lRow As Long, lCol As Long
Dim vListSource() As Variant, vListTarget() As Variant
'Assign soure array
vListSource = Sheets("Sheet11").Range("A2:A17").Value
'Show full content for debug
For lRow = LBound(vListSource) To UBound(vListSource) ' First array dimension is rows.
For lCol = LBound(vListSource, 2) To LBound(vListSource, 2) ' Second array dimension is columns.
Debug.Print vListSource(lRow, lCol)
Next lCol
Next lRow
'Transfer array to one dimension
ReDim vListTarget(LBound(vListSource) To UBound(vListSource))
For lRow = LBound(vListSource) To UBound(vListSource)
vListTarget(lRow) = vListSource(lRow, LBound(vListSource, 2))
Next lRow
'Your check code
For lRow = LBound(vListTarget) To UBound(vListTarget)
If vListTarget(lRow) = Now() Then
'Do something here
End If
Next lRow
End Sub
This will copy the first row of your range/array to a one dimensional array and use this for further processing.
However, from your code and question I do not see the advantage of redimming it to one dimension - you could easily do your loop one the two dimensional array - and just look in the first and only column.