Home > Software engineering >  VBA load array elements until value is found not working
VBA load array elements until value is found not working

Time:10-27

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.

enter image description here

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. enter image description here

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

  • Related