0

This compares a Customer Name and Part Number on sheet Temp (about 50 rows) to Customer Name and Part Number on sheet Data (about 20,000 rows). If the name and number are found in Data, then the associated information from that same row in Temp is added to Data.

This works great unless a name and number in Temp are not found in Data. When that occurs, a "Subscript out of range" error is generated. To me, it seems like the code is trying to find that value from Temp, and when it cannot find it, it just gives us and throws the error.

Can the code be revised to say, "Hey, if you cannot match a value, it's okay, just skip it and keep going"?

Sub MergeRMAArray()
'##############################################################################
' Creates arrays from "Temp RMA" & "Data" sheets, then compares rows on RMA and when a match occurs,
' pastes values in temp array. After loops, temp array values paste to "Data" sheet.
'##############################################################################
' If when processed there is an error, and the highlighted section states "Subscript out of range", with i+j
' being larger than the rows shown, then one potential error could be that a part on the RMA tab is not
' present in the Data tab, so the macro keeps searching. Will need to try and fix this on the next revision.
'##############################################################################
'##############################################################################
    Set Data = Worksheets("Data")
    Set Temp = Sheets("Temp RMA")
    Data.Activate
    Dim arrA, arrB, arrC As Variant
    Dim i, j, k, LastRow2 As Long
        LastRow = Data.Cells(Cells.Rows.Count, "A").End(xlUp).Row
        LastRow2 = Temp.Cells(Cells.Rows.Count, "A").End(xlUp).Row
        arrA = Data.Range("A2:B" & LastRow)
        arrB = Temp.Range("A2:H" & LastRow2)
    ReDim arrC(1 To LastRow - 1, 1 To 4)

    For i = LBound(arrB) To UBound(arrB)
        j = 0
        For k = LBound(arrA) To UBound(arrA)
            If (arrB(i, 1) = arrA(i + j, 1) _
            And arrB(i, 2) = arrA(i + j, 2) _
            And arrC(i + j, 1) = "") Then
                arrC(i + j, 1) = arrB(i, 5)
                arrC(i + j, 2) = arrB(i, 6)
                arrC(i + j, 3) = arrB(i, 7)
                arrC(i + j, 4) = arrB(i, 8)
                Exit For
            End If
                j = j + 1
        Next k
    Next i
    Range("W2").Resize(UBound(arrC, 1), UBound(arrC, 2)).Value = arrC
    Erase arrA, arrB, arrC

End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
DaShMa
  • 1
  • What line throws the error? – BigBen Jun 04 '20 at 13:17
  • Generally it'll be the whole If statement that is highlighted. Value 'i' may be 4, while value 'j' will be the total of all rows on Data minus 4. – DaShMa Jun 04 '20 at 13:19
  • Why do you never use `k` inside your loop? – BigBen Jun 04 '20 at 13:21
  • Not an answer to your question but I see you haven't yet declared your variables properly. It's something that may seem logical, but only the last variable in your statements take on `Long`. Otherwise it would be a `Variant` and `VBA` will start making guesses what this is a variant of, the first time you use them in code. Just something to bare in mind. – JvdV Jun 04 '20 at 13:22
  • I don't have an answer for that, but now you have me thinking... – DaShMa Jun 04 '20 at 13:24
  • @JvdV Can you give me an example from my code? I'm not quite following, but I'd love to learn. – DaShMa Jun 04 '20 at 13:26
  • 3
    Yes, where you'd probably expect all variables in `Dim i, j, k, LastRow2 As Long` to be of type `Long`. Inspection of local variables will let you see only `LastRow2` actually is. Another thing (if you are not so lazy as I am) to do is using `Option Explicit` on the top, which will show you that `LastRow` has not been declared at all for example. So proper syntax would be `Dim i as Long, j as Long, etc etc.....`. – JvdV Jun 04 '20 at 13:29
  • Just one more thing I noticed is you are also using what is called *implicit* references to the then `ActiveSheet`. You came so far as creating worksheet variables but have not used them in *explicit* references, e.g.: `Data.Cells(Cells.Rows.Count, "A").End(xlUp).Row` for example where `Cells.Rows.Count` does **not** refer to `Data` at all. Also a common mistake =) – JvdV Jun 04 '20 at 13:30
  • ^ and in `Cells.Rows.Count`, the `Cells` is redundant: `Data.Rows.Count` would reflect all the rows on the data sheet. – BigBen Jun 04 '20 at 13:33
  • Ah, makes sense. I actually use `Option Explicit` and also declare `LastRow2` as `Long` at the top of my whole module. Double declaring it in this macro was an oversight. Thank you for pointing this out though, since now I can improve it and I've learned more. – DaShMa Jun 04 '20 at 13:34
  • Hmm, so even though I began with `Data.Cells`, it still doesn't refer to `Data`? – DaShMa Jun 04 '20 at 13:39
  • The inner `Cells` in `Cells.Rows.Count` does not, it refers to the active sheet. – BigBen Jun 04 '20 at 13:40
  • Could I just revise to be, `LastRow = Data.Rows.Count, "A".End(xlUp).Row`? – DaShMa Jun 04 '20 at 13:40
  • See how to use a `With` block... in [this question](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba). – BigBen Jun 04 '20 at 13:44

1 Answers1

0

You are copying from "Temp" but arrC size is that of "Data". Need to change the Redim Statement. Also, J will reach 20000 each time (Data rows) at that point it will also add i which and then it will go beyond 20000 (Size of arrC) and hence the "Subscript out of Range" error.

Replace redim an loop with following.

m = 0
ReDim arrC(1 To LastRow2 - 1, 1 To 4)
For i = LBound(arrB, 1) To UBound(arrB, 1)
    For j = LBound(arrA, 1) To UBound(arrA, 1)
        If arrB(i, 1) = arrA(j, 1) _
        And arrB(i, 2) = arrA(j, 2) Then
            m = m + 1
            arrC(m, 1) = arrB(i, 5)
            arrC(m, 2) = arrB(i, 6)
            arrC(m, 3) = arrB(i, 7)
            arrC(m, 4) = arrB(i, 8)
        End If
    Next j
Next i

Looking at the number of loops in question (50*20,000 = 1000,000) and comparisons in arrays, suggesting following procedure using Range.Find method along with Range.Offset. This will cause much less loops and comparisons compared to those in the question.

Sub MergeRMAArray()
'##############################################################################
' "Temp RMA" & "Data" sheets, compares rows on RMA and when a match occurs,
' pastes values in temp sheet Columns E:H to "Data" sheet.
'##############################################################################

Dim Data As Worksheet: Set Data = Worksheets("Data")
Dim Temp As Worksheet: Set Temp = Sheets("Temp RMA")
Dim i As Long, j As Long, x As Long, y As Long, k As Long
Dim fRG As Range, outPut As Range, rw As Range

Dim dLR As Long: dLR = Data.Cells(Cells.Rows.Count, "A").End(xlUp).Row - 1
Dim tLR As Long: tLR = Temp.Cells(Cells.Rows.Count, "A").End(xlUp).Row - 1
Dim dRG As Range: Set dRG = Data.Range("A2:B" & dLR)
Dim tRG As Range: Set tRG = Temp.Range("A2:H" & tLR)

'Find the values in Temp sheet col A & B in Data sheet Col A & B
'If found union the range from corresponding row in Temp col E to H
For i = 1 To tLR '50 loops
    On Error Resume Next
    Set fRG = dRG.Columns(1).Find(What:=tRG(i, 1), After:=dRG(dRG.Rows.Count, 1), _
        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    If Not fRG Is Nothing Then
    If tRG(i, 2) = fRG.Offset(0, 1) Then
        If outPut Is Nothing Then
        Set outPut = tRG(i, 1).Offset(0, 4).Resize(1, 4)
        Else
        Set outPut = Union(outPut, tRG(i, 1).Offset(0, 4).Resize(1, 4))
        End If
    End If
    End If
Next

'Put all the outPut range values in arrC
Dim arrC
For Each Area In outPut.Areas 'max 50 loops
    x = x + Area.Rows.Count
Next
y = outPut.Columns.Count
ReDim arrC(1 To x, 1 To y)

i = 0
For k = 1 To outPut.Areas.Count 'max 50*50 = 2500 loops
For Each rw In outPut.Areas(k).Rows
    i = i + 1
    arr = rw.Value
    For j = 1 To y
    arrC(i, j) = Split(Join(Application.Index(arr, 1, 0), "|"), "|")(j - 1)
    Next
Next
Next

'Copy outPut values (stored in arrC) to Range("W2") in Data sheet
Data.Range("W2").Resize(x, y).Value = arrC

End Sub
Naresh
  • 2,984
  • 2
  • 9
  • 15