Home > Mobile >  VBA, array looping, subscript out of range
VBA, array looping, subscript out of range

Time:11-10

I am getting subscript out of range error 9 on my 2nd lineof the For loop below. i = 7 (row number), and c1 = 59, c2=60 (column numbers). Why am I not getting subscript out of range here?

Should I be using 1 or 2 instead of c1 or c2? When I use 1 or 2 it is not picking up my columns correctly.

Dim c1 As Variant
Dim c2 As Variant
Dim arr() as Variant

Set rw = ws.Rows(6)
lastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row 

c1 = Application.Match("Col 59)", rw, 0)
c2 = Application.Match("Col 60", rw, 0)

If Not IsError(c1) And Not IsError(c2) Then    'found both column headers?
    arr = ws.Range(rw.Cells(c1), rw.Cells(c2)).Resize(lastR).Value2
Else
    MsgBox "One or both required column headers not found!"
End If
    

'Loop to find Empty and Non empty fields
For i = 7 To UBound(arr) 'Row 7 is the row the data starts
    If (arr(i, c1) <> "" And arr(i, c2) = "") Or (arr(i, c2) <> "" And arr(i, c1) = "") Then        
        addToRange rngCopy, ws.Range("A" & i)
    End If
Next i
      

CodePudding user response:

Try this out - more code, but it saves you from needing to do any math on the array vs. range coordinates:

Sub Tester()
    Const HEADER_ROW As Long = 6
    Dim c1 As Variant, c2 As Variant, ws As Worksheet, rw As Range, lastR As Long
    Dim arr1 As Variant, arr2 As Variant, rng1 As Range, rng2 As Range, v1, v2
    Dim i As Long, rngCopy As Range
    
    Set ws = ActiveSheet 'or some other specific sheet
    Set rw = ws.Rows(HEADER_ROW)
    lastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    c1 = Application.Match("Col 59)", rw, 0)
    c2 = Application.Match("Col 60", rw, 0)
    
    If Not IsError(c1) And Not IsError(c2) Then    'found both column headers?
        'define two ranges to pick up values from
        Set rng1 = ws.Range(rw.Cells(c1), ws.Cells(lastR, c1))
        Set rng2 = ws.Range(rw.Cells(c2), ws.Cells(lastR, c2))
        'fill the arrays
        arr1 = rng1.Value2
        arr2 = rng2.Value2
    Else
        MsgBox "One or both required column headers not found!"
        Exit Sub
    End If
        
    'Loop to find Empty and Non empty fields
    For i = 2 To UBound(arr1, 1) 'i=1 would be the column headers
        v1 = arr1(i, 1)         'read the two values to be compared
        v2 = arr2(i, 1)
        If (v1 <> "" And v2 = "") Or (v1 = "" And v2 <> "") Then
            addToRange rngCopy, ws.Cells(rng1.Cells(i).Row, "A")
        End If
    Next i
End Sub
  • Related