Double "select row based on value in column"

user_15265213 0
Viewed 74

I need to select an entire row based on criteria value="REZ" in column "C".

Dim c As Range
Dim rngG As Range
 
For Each c In Intersect(ActiveSheet.UsedRange, Columns("C"))
 
    If c = "REZ" Then
        If rngG Is Nothing Then Set rngG = c.EntireRow
        Set rngG = Union(rngG, c.EntireRow)
    End If
 
Next c
rngG.Select

Each selected row has some value in column "J".

I now need to additionally select all entire rows that contains those values gotten from first step.

Images to better explain:
First get rows with "REZ" in column "C"
https://i.stack.imgur.com/uwHzT.png

Now we know that rows value in column "J" which in this case is "27.2.12".
So now in addition to what we have selected we need to select all the rows that contain "27.2.12" which is ALWAYS some number of rows directly after the row found and selected in step 1 and never match exactly as each value in column "J" is unique.

In this case it would be:
enter image description here

I imagine two IF functions where the second one takes the info from the result of the first.

Workbook example: https://easyupload.io/yewg9o

I highlighted "REZ" rows with yellow that are selected in step 1 and cells that I expect to be selected based on step 1 are highlighted with green.

if-statement vba excel
1 Answers

Try this out:

Sub Tester()

    Dim c As Range, ws As Worksheet
    Dim rngG As Range, lastJ, rngJ As Range
    
    Set ws = ActiveSheet

    For Each c In Intersect(ws.UsedRange, ws.Columns("C"))
        Set rngJ = c.EntireRow.Columns("J")
        If c = "REZ" Then
            AddRange rngG, c.EntireRow
            lastJ = rngJ.Value   'remember the J value
        Else
            'not REZ, but see if we're to check for matching J values
            If Len(lastJ) > 0 Then
                If rngJ.Value Like lastJ & "*" Then
                    AddRange rngG, c.EntireRow
                Else
                    lastJ = "" 'stop checking on first non-match
                End If
            End If
        End If
    Next c
    rngG.Select
End Sub

'Utility sub for building up a range
Sub AddRange(rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub
user_4788840
Related