Reputation: 68
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"
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.
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.
Upvotes: 2
Views: 125
Reputation: 166351
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
Upvotes: 3