J.T.
J.T.

Reputation: 31

VBA If And multiple conditions

Could anyone help troubleshoot my coding? The If statement requires three separate conditions = true or it checks the next if statement and loop back for the all cells the array. There is no error so its difficult to determine the issue, plus I'm very new to VBA so there is probably a better way to accomplish this.

Note: The cells needed in the arrays are not static hence the Find.

    Sub test()
Dim i As Integer
Dim col1 As Range, col2 As Range, col3 As Range, col4 As Range, col5 As Range, col6 As Range
Dim c1arr, c2arr, c3arr, c4arr, c5arr, c6arr As Variant

Set col1 = ActiveSheet.Cells.find("Reference", , xlValues, xlWhole)
Set col2 = ActiveSheet.Cells.find("Amount", , xlValues, xlWhole)
Set col3 = ActiveSheet.Cells.find("Action", , xlValues, xlWhole)
Set col4 = ActiveSheet.Cells.find("Reference2", , xlValues, xlWhole)
Set col5 = ActiveSheet.Cells.find("Amount2", , xlValues, xlWhole)
Set col6 = ActiveSheet.Cells.find("Action2", , xlValues, xlWhole)

lastrow = Cells(Rows.Count, col1.Column).End(xlUp).Row

c1arr = Range(Cells(2, col1.Column), Cells(lastrow, col1.Column)).Value
c2arr = Range(Cells(2, col2.Column), Cells(lastrow, col2.Column)).Value
c3arr = Range(Cells(2, col3.Column), Cells(lastrow, col3.Column)).Value
c4arr = Range(Cells(2, col4.Column), Cells(lastrow, col4.Column)).Value
c5arr = Range(Cells(2, col5.Column), Cells(lastrow, col5.Column)).Value
c6arr = Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value

For i = 1 To UBound(c1arr)
    If c2arr(i, 1) > 0 And c1arr(i, 1) = c4arr(i, 1) And c2arr(i, 1) = c5arr(i, 1) Then
            c6arr(i, 1) = c3arr(i, 1)
    ElseIf c2arr(i, 1) > 0 And c1arr(i, 1) <> c4arr(i, 1) And c2arr(i, 1) <> c5arr(i, 1) Then
            c6arr(i, 1) = "Manual Review"
    End If
Next

Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value = c6arr
End Sub

UPDATED IMAGE

Upvotes: 0

Views: 5579

Answers (2)

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60389

It is not clear to me, from your code and your example, when you want to see "Manual Review" in Action2. Obviously, if References match but Amounts do not; but since that does not encompass all of the possibilities, that part of the code is a bit "sloppy". In the code below, all instances where there is no match will be marked "Manual Review". If that is truly the case, then the code could be made a bit cleaner (and faster).

Here's another way of doing this, using WorksheetFunction.Match.

Option Explicit
   Sub test()
Dim i As Integer, lastrow As Long, J As Long
Dim col1 As Range, col2 As Range, col3 As Range, col4 As Range, col5 As Range, col6 As Range
Dim c1arr, c2arr, c3arr, c4arr, c5arr, c6arr As Variant


Set col1 = ActiveSheet.Cells.Find("Reference", , xlValues, xlWhole)
Set col2 = ActiveSheet.Cells.Find("Amount", , xlValues, xlWhole)
Set col3 = ActiveSheet.Cells.Find("Action", , xlValues, xlWhole)
Set col4 = ActiveSheet.Cells.Find("Reference2", , xlValues, xlWhole)
Set col5 = ActiveSheet.Cells.Find("Amount2", , xlValues, xlWhole)
Set col6 = ActiveSheet.Cells.Find("Action2", , xlValues, xlWhole)

lastrow = Cells(Rows.Count, col1.Column).End(xlUp).Row

c1arr = Range(Cells(2, col1.Column), Cells(lastrow, col1.Column)).Value
c2arr = Range(Cells(2, col2.Column), Cells(lastrow, col2.Column)).Value
c3arr = Range(Cells(2, col3.Column), Cells(lastrow, col3.Column)).Value
c4arr = Range(Cells(2, col4.Column), Cells(lastrow, col4.Column)).Value
c5arr = Range(Cells(2, col5.Column), Cells(lastrow, col5.Column)).Value
c6arr = Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value

'Clear c6arr
ReDim c6arr(1 To UBound(c6arr, 1), 1 To 1)

For i = 1 To UBound(c1arr)
    If c2arr(i, 1) > 0 Then
        On Error Resume Next
            J = WorksheetFunction.Match(c1arr(i, 1), c4arr, 0)
            If Err.Number = 0 Then
                If c2arr(i, 1) = c5arr(J, 1) Then
                    c6arr(J, 1) = c3arr(i, 1)
                Else
                    c6arr(J, 1) = "Manual Review"
                End If
            End If
        On Error GoTo 0
    End If
Next i

'Fill the blanks
For i = 1 To UBound(c6arr, 1)
    If c6arr(i, 1) = "" Then c6arr(i, 1) = "Manual Review"
Next i

Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value = c6arr
End Sub

These are the results using your most recently posted image:

enter image description here

Upvotes: 0

OldUgly
OldUgly

Reputation: 2119

Added an extra loop and broke up the if logic in order to get the correct (?) behavior.

I get these results ...

enter image description here

... from this code ...

Sub test()
Dim i As Integer, j As Integer, lastrow As Long
Dim col1 As Range, col2 As Range, col3 As Range, col4 As Range, col5 As Range, col6 As Range
Dim c1arr, c2arr, c3arr, c4arr, c5arr, c6arr As Variant

    Set col1 = ActiveSheet.Cells.Find("Reference", , xlValues, xlWhole)
    Set col2 = ActiveSheet.Cells.Find("Amount", , xlValues, xlWhole)
    Set col3 = ActiveSheet.Cells.Find("Action", , xlValues, xlWhole)
    Set col4 = ActiveSheet.Cells.Find("Reference2", , xlValues, xlWhole)
    Set col5 = ActiveSheet.Cells.Find("Amount2", , xlValues, xlWhole)
    Set col6 = ActiveSheet.Cells.Find("Action2", , xlValues, xlWhole)

    lastrow = Cells(Rows.Count, col1.Column).End(xlUp).Row

    c1arr = Range(Cells(2, col1.Column), Cells(lastrow, col1.Column)).Value
    c2arr = Range(Cells(2, col2.Column), Cells(lastrow, col2.Column)).Value
    c3arr = Range(Cells(2, col3.Column), Cells(lastrow, col3.Column)).Value

    lastrow = Cells(Rows.Count, col4.Column).End(xlUp).Row

    c4arr = Range(Cells(2, col4.Column), Cells(lastrow, col4.Column)).Value
    c5arr = Range(Cells(2, col5.Column), Cells(lastrow, col5.Column)).Value
    c6arr = Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value

    For i = 1 To UBound(c4arr)
        If c6arr(i, 1) = "" Then ' if already determined an answer, don't try again
            For j = 1 To UBound(c1arr)
                If c1arr(j, 1) = c4arr(i, 1) Then ' found Reference2 within Reference
                    If c2arr(j, 1) = c5arr(i, 1) And c2arr(j, 1) > 0 Then
                        c6arr(i, 1) = c3arr(j, 1)
                    Else
                        c6arr(i, 1) = "Manual Review"
                    End If
                End If
            Next j
        End If
        If c6arr(i, 1) = "" Then ' if haven't found an answer yet, it needs review
            c6arr(i, 1) = "Manual Review"
        End If
    Next i

    Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value = c6arr

End Sub

Upvotes: 1

Related Questions