Highlighting every 3 row with VBA?

[XcelNoobster]

So I have a macro, that generates a sheet("Results") that contains the (A) location, sheet name, etc where an employee Id is found. And above each row(A), I also output the headers for the sheets where the Employee Id is found. I then give an extra row separating the next entry. How would I modify my macro so it highlights that extra row? The first entry(Header) start at row# 2, so row 4 should be highlighted.

Sub findIDs2()

' findIDs2 Macro
' Once Parsed1 is run, run findIDs2 macro to output location and entire line where that Id is found.
'
    Application.ScreenUpdating = False
    Dim srcRng As Range, rng As Range, sAddr As String, fnd As Range, ws As Worksheet, x As Long: x = 2
    Dim rngWs As Range
    Dim y As Long: y = 1
    
    Set srcRng = Sheets("IDs").Range("A1", Sheets("IDs").Range("A" & Rows.Count).End(xlUp))
    
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Results"
    Sheets("Results").Activate
    Range("M1").Value = "Employee ID"
    Range("M1").Font.Color = vbRed
    Range("N1").Value = "Record Location"
    Range("N1").Font.Color = vbRed
    Range("O1").Value = "Record Sheet"
    Range("O1").Font.Color = vbRed
    
    
    
    
    
    
    For Each rng In srcRng
        For Each ws In Sheets
            If ws.Name <> "IDs" And ws.Name <> "Results" Then
                Set fnd = ws.Cells.Find(rng, LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    sAddr = fnd.Address
                    Do
                        With Sheets("Results")
                        'Change x to x+1
                            .Columns.ColumnWidth = 20
                            .Range("M" & x + 1) = fnd
                            .Range("N" & x + 1) = fnd.Address
                            .Range("O" & x + 1) = ws.Name
                            'try add something like this use the row number that the headers are on
                        ws.Rows(1).EntireRow.Copy
                        .Range("A" & x).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                         Set rngWs = Intersect(fnd.EntireRow, fnd.CurrentRegion)
                    rngWs.Copy
                     .Range("A" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    'Change to x+2 from x+1  + 3 ----> mihgt cause issue need to check
                    x = x + 3
                End With
                Set fnd = ws.Cells.FindNext(fnd)
            Loop While fnd.Address <> sAddr
                    sAddr = ""
                End If
            End If
        Next ws
    Next rng
    
    Application.ScreenUpdating = True
End Sub

 

[rollis13]

This does what you asked, add this line here:

'...
rngWs.Copy
.Range("A" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("A" & x + 2 & ":O" & x + 2).Interior.Color = 65535 '(yellow)       '<- added
'Change to x+2 from x+1  + 3 ----> mihgt cause issue need to check
x = x + 3
'...