I am having an issue with the logic for what I need to do to get my array to load correctly. I currently have an array loading column references from column C the picture below. The user will enter in the current month, i.e. March, then the array should load February column value "U" and January value "L", then the rest of my code will run. My issue is that I can't figure out how to setup the array to stop after the value "L" is found.
Sub CopyData() 'with array
Dim wb1 As Workbook
Dim wkshtname As String
Dim colArray(1 To 5) As Variant
Dim i As Range, rng As Range
Dim lrow As Long, colcounter As Long, y As Long, retcol As Long, z As Long
Dim StartHere As String, x As String, col As String
Dim cell
Dim sht As Worksheet
Set wb1 = ThisWorkbook
wkshtname = "Retro-" & wb1.Sheets("Instructions").Range("B4").Value
StartHere = wb1.Sheets("Instructions").Range("B4")
lrow = wb1.Sheets("Member Prem.Pymts").Cells(Rows.Count, 1).End(xlUp).Row
If StartHere = "January" Then
MsgBox "No Retro Commissions to be posted", vbOKOnly
Exit Sub
End If
'delete sheet if it exists
For Each sht In wb1.Worksheets
If sht.Name = wkshtname Then
Application.DisplayAlerts = False
wb1.Sheets(wkshtname).Delete
Application.DisplayAlerts = True
End If
Next sht
With wb1
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = wkshtname
With .Sheets(wkshtname)
.Cells(1).Resize(1, 8).Value = Array("ID", "Last Name", "First Name", "Premium", "Commission Amt", "month for", "agent", "sheet row")
End With
'returns Paid in Month 30-150 day columns
col = Application.WorksheetFunction.Match(StartHere, wb1.Sheets("Lookups").Range("$A$1:$A$13"), 0)
z = 1
For retcol = 1 To 5
colArray(retcol) = wb1.Sheets("Lookups").Cells(col - z, 3)
z = z 1
Next retcol
With .Sheets("Member Prem.Pymts") 'reference target sheet
y = 1
For colcounter = LBound(colArray, 1) To UBound(colArray, 1)
x = 4 'starting row number data is found on
For Each i In .Range(colArray(colcounter) & "4:" & colArray(colcounter) & lrow) 'loop through Member Prem.Payments column cells
If i.Value = StartHere Then
wb1.Sheets(wkshtname).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("A" & x)
wb1.Sheets(wkshtname).Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = .Range("B" & x)
wb1.Sheets(wkshtname).Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) = .Range("C" & x)
wb1.Sheets(wkshtname).Cells(Rows.Count, "D").End(xlUp).Offset(1, 0) = .Range("BR" & x)
wb1.Sheets(wkshtname).Cells(Rows.Count, "E").End(xlUp).Offset(1, 0) = wb1.Sheets("Commissions to Pay").Range(wb1.Sheets("Lookups").Cells(col - y, 4) & x)
wb1.Sheets(wkshtname).Cells(Rows.Count, "F").End(xlUp).Offset(1, 0) = .Range(colArray(colcounter) & "2")
wb1.Sheets(wkshtname).Cells(Rows.Count, "G").End(xlUp).Offset(1, 0) = .Range("DR" & x)
wb1.Sheets(wkshtname).Cells(Rows.Count, "H").End(xlUp).Offset(1, 0) = x
End If
x = x 1
Next
y = y 1
Next colcounter
End With
End Sub
This is what is currently stored in the array when I run the code above. What I'm trying to do is have it load the array and then the array needs to stop loading after the value is "L". I've tried just about everything and I know its a simple fix, but i'm not really good with working with arrays. The array will never have more than 5 elements in it.
CodePudding user response:
EDIT: Stripped down to the core problem for testing
Sub CopyData()
Dim rngMonths As Range, c As Range, wb1
Dim colArray(), StartHere, col, retcol As Long
Set wb1 = ActiveWorkbook
Set rngMonths = wb1.Sheets("Lookups").Range("A2:A13") 'month lookup range
StartHere = "March" 'for testing
col = Application.Match(StartHere, rngMonths, 0)
If Not IsError(col) Then
Set c = rngMonths.Cells(col)
ReDim colArray(1 To 5) '<<<<<<<<<<<<
For retcol = 1 To 5
colArray(retcol) = c.Offset(0, 2).Value 'col C value
If colArray(retcol) = "L" Then Exit For 'exit if Col C="L"
Set c = c.Offset(-1) 'next cell up
Next retcol
ReDim Preserve colArray(1 To retcol) '<<<<<resize array
Debug.Print Join(colArray, ",")
Else
MsgBox "No month match!", vbExclamation
Exit Sub
End If
End Sub