Redim An Array To Load Combo Box
For complete information on arrays, see Arrays
Many programs will process a variable number if items to load into a form's combo box. Using the Redim command, an array can be "max sized", and then based on the actual number of items encountered in the data, it can be redimensioned to the exact number of items in the array. This redimensioning is necessary to load a combo box using an efficient "one line" load statement.
A combo box can also be loaded "one item at a time", but bulk loading using a redimensioned array is the fastest method and requires less code.
Program Code
Option Explicit ' *************************************************************** ' Use Option Base 1 Since I Start Indexing at 1 and not 0 ' *************************************************************** Option Base 1 ' *************************************************************** ' Define The Array With No Value For the Number Of Entries ' *************************************************************** Public strProductID() As String Public Sub DemoRedimArray() ' *************************************************************** ' Before the Array is Used, It Must Be Dimensioned ' To A Maximum Value For The Number Of Entries ' That Could Be Loaded ' *************************************************************** ReDim strProductID(200) ' *************************************************************** ' Dynamically Load Values - Usually Done With A Counter ' But For Demo Purposes, Hard Coded Values Are Used ' *************************************************************** strProductID(1) = "AAAAA" strProductID(2) = "BBBBB" strProductID(3) = "CCCCC" strProductID(4) = "DDDDD" strProductID(5) = "EEEEE" ' *************************************************************** ' When The Number of ACTUAL Entries Loaded in the Array ' Has Been Determined, REDIM The Array with a Preserve ' *************************************************************** ReDim Preserve strProductID(5) ' *************************************************************** ' Load A Form's Combo Box With The Exact Number Of Array Entries ' *************************************************************** frmProducts.cmbProductID.List = strProductID ' *************************************************************** ' Display The Form And Its Entries ' *************************************************************** frmProducts.Show End Sub
Dynamically Redim Arrays As They Are Loaded
The following code illustrates how to REDIM PRESERVE an array as it is loaded so that the dimensions are always up to date.
Program Code
Public Sub UpdateScheduleFromJobSource()
' ********************************************************
' Define Known Workbook and Worksheet Variables
' ********************************************************
Dim wkbJobSchedule As Workbook
Dim wksJobSchedule As Worksheet
Dim wksListDropDown As Worksheet
Dim wksJobSourceToCopyFrom As Worksheet
Dim wksTestIfSheetExists As Worksheet
' ********************************************************
' Define Variable Job Source Worksheets
' ********************************************************
Dim strJobSourceWorksheetName() As String
Dim intJobSourceWorksheetIndex() As Integer
Dim wksJobSource() As Worksheet
' ********************************************************
' Other Variables
' ********************************************************
Dim intJobSourceWorksheetCount As Integer
Dim lngLastTargetJobSourceWorksheetRow As Long
Dim strJobSourceWorksheetNameForCopy As String
Dim lngJobSourceRowToBeCopied As Long
Dim lngJobScheduleTargetRow As Long
Dim lngMessageResponse As Long
Dim i As Long
' ********************************************************
' Define Target Row in Job Source
' ********************************************************
If ActiveSheet.Name <> "Schedule" Then
MsgBox ("1> You Must Select A Job Source Cell" & vbCrLf & _
"2> Then Press Alt-F8 To Run The Macro Called a_MarkJobSourceLocation" & vbCrLf & _
"3> Then Select The Target Job Schedule Line To Be Updated" & vbCrLf & _
"4> Then Click The 'Update Job Schedule Line From Job Source' Button")
strJobSourceNameToBeUpdated = ""
lngJobSourceRowToUpdate = 0
Exit Sub
End If
lngJobScheduleTargetRow = ActiveCell.Row
If lngJobScheduleTargetRow < 3 Then
MsgBox ("1> You Must Select A Job Source Cell" & vbCrLf & _
"2> Then Press Alt-F8 To Run The Macro Called a_MarkJobSourceLocation" & vbCrLf & _
"3> Then Select The Target Job Schedule Line To Be Updated" & vbCrLf & _
"4> Then Click The 'Update Job Schedule Line From Job Source' Button")
strJobSourceNameToBeUpdated = ""
lngJobSourceRowToUpdate = 0
Exit Sub
End If
' ***********************************************
' Make Sure A Job Source Worksheet Line Was
' Marked As The Source Of The Update
' ***********************************************
If strJobSourceNameToBeUpdated = "" Or lngJobSourceRowToUpdate = 0 Then
MsgBox ("1> You Must Select A Job Source Cell" & vbCrLf & _
"2> Then Press Alt-F8 To Run The Macro Called a_MarkJobSourceLocation" & vbCrLf & _
"3> Then Select The Target Job Schedule Line To Be Updated" & vbCrLf & _
"4> Then Click The 'Update Job Schedule Line From Job Source' Button")
strJobSourceNameToBeUpdated = ""
lngJobSourceRowToUpdate = 0
Exit Sub
End If
' ***********************************************
' Change Names To Match Actual Function
' ***********************************************
strJobSourceWorksheetNameForCopy = strJobSourceNameToBeUpdated
lngJobSourceRowToBeCopied = lngJobSourceRowToUpdate
' ***********************************************
' Initialize The Workbook and Worksheet Variables
' ***********************************************
Set wkbJobSchedule = ThisWorkbook
Set wksJobSchedule = wkbJobSchedule.Sheets("Schedule")
Set wksListDropDown = wkbJobSchedule.Sheets("ListDropDown")
intJobSourceWorksheetCount = 0
lngLastTargetJobSourceWorksheetRow = wksListDropDown.Cells(Rows.Count, "W").End(xlUp).Row
For i = 4 To lngLastTargetJobSourceWorksheetRow
On Error Resume Next
Set wksTestIfSheetExists = Nothing
Set wksTestIfSheetExists = Sheets(wksListDropDown.Cells(i, 23).Value)
If wksTestIfSheetExists Is Nothing Then
MsgBox ("Job Source Worksheet " & wksListDropDown.Cells(i, 23).Value & " Does Not Exist")
Err.Clear
Else
On Error GoTo 0
intJobSourceWorksheetCount = intJobSourceWorksheetCount + 1
ReDim Preserve strJobSourceWorksheetName(1 To intJobSourceWorksheetCount)
ReDim Preserve intJobSourceWorksheetIndex(1 To intJobSourceWorksheetCount)
ReDim Preserve wksJobSource(1 To intJobSourceWorksheetCount)
strJobSourceWorksheetName(intJobSourceWorksheetCount) = wksListDropDown.Cells(i, 23).Value
intJobSourceWorksheetIndex(intJobSourceWorksheetCount) = wksTestIfSheetExists.Index
Set wksJobSource(intJobSourceWorksheetCount) = Sheets(intJobSourceWorksheetIndex(intJobSourceWorksheetCount))
End If
Next i
On Error GoTo 0
' ***********************************************
' Validate The Job Source Worksheet Is Valid
' ***********************************************
Set wksJobSourceToCopyFrom = Nothing
For i = 1 To UBound(strJobSourceWorksheetName)
If strJobSourceWorksheetNameForCopy = strJobSourceWorksheetName(i) Then
Set wksJobSourceToCopyFrom = wksJobSource(i)
Exit For
End If
Next i
If wksJobSourceToCopyFrom Is Nothing Then
MsgBox ("1> You Must Select A Job Source Cell" & vbCrLf & _
"2> Then Press Alt-F8 To Run The Macro Called a_MarkJobSourceLocation" & vbCrLf & _
"3> Then Select The Target Job Schedule Line To Be Updated" & vbCrLf & _
"4> Then Click The 'Update Job Schedule Line From Job Source' Button")
strJobSourceNameToBeUpdated = ""
lngJobSourceRowToUpdate = 0
Exit Sub
End If
lngMessageResponse = MsgBox("You Are About To Update Job Schedule Row " & lngJobScheduleTargetRow & vbCrLf & _
"From Job Source Worksheet " & strJobSourceWorksheetNameForCopy & ", Row " & _
lngJobSourceRowToBeCopied & vbCrLf & _
"Is This Correct?", vbYesNo, "Update Job Schedule From Job Source")
If lngMessageResponse = vbNo Then
strJobSourceNameToBeUpdated = ""
lngJobSourceRowToUpdate = 0
Exit Sub
End If
' ***********************************************
' Update The Job Schedule From The Job Source
' ***********************************************
wksJobSchedule.Cells(lngJobScheduleTargetRow, 2).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 32)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 6).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 5)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 7).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 6)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 8).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 7)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 9).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 8)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 10).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 9)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 11).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 10)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 12).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 11)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 13).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 12)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 14).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 13)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 15).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 14)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 16).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 15)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 17).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 16)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 18).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 17)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 19).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 18)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 20).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 19)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 25).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 22)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 26).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 33)
wksJobSchedule.Cells(lngJobScheduleTargetRow, 27).Value = wksJobSourceToCopyFrom.Cells(lngJobSourceRowToBeCopied, 34)
End Sub