excelvbaindexingmatch

Find match value VBA on 4 conditions

Can anybody help with this? look at the picture I upload.tab1 I have 2 stores with the same location in column "A" and "G", column "B and I" says condition on location. And column "E" where should shown result if column "I" is blank and also column "B" is blank and only if store2 with location from column "G" match location in column "A", mean not all store2 location are in location column "A". I have code, but this is giving me only if column "A" match column "G" and column "B" is blank. But I want give me result if A match G and if B is blank and also I is blank only. The code:

Sub ListMatchesInE()

Dim ws As Worksheet
Dim lastRowA As Long, lastRowG As Long
Dim i As Long, pasteRow As Long
Dim valA As Variant
Dim valB As Variant

Set ws = ThisWorkbook.ActiveSheet

' Find last used row in columns A and G
lastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastRowG = ws.Cells(ws.Rows.Count, 7).End(xlUp).Row

' Clear previous results in E
ws.Range("E2:E" & ws.Rows.Count).ClearContents

pasteRow = 2

For i = 2 To lastRowA
    valA = ws.Cells(i, 1).Value ' Column A
    valB = ws.Cells(i, 2).Value ' Column B
    
    ' Check: Column B is truly blank (empty or zero-length string)
    If IsError(valB) = False Then
        If Len(Trim(valB)) = 0 Then
            ' Check if value in A exists in column G
            If Application.WorksheetFunction.CountIf(ws.Range("G2:G" & lastRowG), valA) > 0 Then
                ws.Cells(pasteRow, 5).Value = valA ' Column E
                pasteRow = pasteRow + 1
            End If
        End If
    End If
Next i

End Sub

Solution

  • Other option:

    Option Explicit

Sub ListMatchesInE_v2()
    Dim i As Long, foundCell As Range

    Dim ws          As Worksheet
    Set ws = ThisWorkbook.ActiveSheet

    Dim lastRow     As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim lastRowG    As Long
    lastRowG = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row

    ws.Range("E2:E" & ws.Rows.Count).ClearContents

    Dim searchRng   As Range
    Set searchRng = ws.Range("G2:G" & lastRowG)

    Dim pasteRow    As Long
    pasteRow = 2

    For i = 2 To lastRow

        If Len(Trim(ws.Cells(i, "B").Value)) = 0 Then

            Set foundCell = searchRng.Find(What:=ws.Cells(i, "A").Value, LookIn:=xlValues, LookAt:=xlWhole)

            If Not foundCell Is Nothing Then

                If Len(Trim(ws.Cells(foundCell.Row, "I").Value)) = 0 Then
                    ws.Cells(pasteRow, "E").Value = ws.Cells(i, "A").Value
                    pasteRow = pasteRow + 1
                End If

            End If

        End If

    Next i

End Sub