S
simplymidori
I have this lovely code: However, I'm looking to see if I can get nofill/no
color on 2 inserted rows. Thanks
Public Sub InsertTwoRowsAfterTotal()
Dim ws As Worksheet
Dim rFound As Range
Dim sFoundFirst As String
For Each ws In ActiveWorkbook.Worksheets
With ws
If .Name <> "TRACKER" Then
With .Columns(8).Cells
Set rFound = .Find( _
What:="Remaining", _
after:=.Item(.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
Searchdirection:=xlNext, _
MatchCase:=False)
If Not rFound Is Nothing Then
sFoundFirst = rFound.Address
Do
rFound.Offset(1, 0).Resize( _
2, 1).EntireRow.Insert _
Shift:=xlShiftDown
Set rFound = .FindNext(after:=rFound)
Loop Until rFound.Address = sFoundFirst
Set rFound = Nothing
End If
End With
End If
End With
Next ws
End Sub
color on 2 inserted rows. Thanks
Public Sub InsertTwoRowsAfterTotal()
Dim ws As Worksheet
Dim rFound As Range
Dim sFoundFirst As String
For Each ws In ActiveWorkbook.Worksheets
With ws
If .Name <> "TRACKER" Then
With .Columns(8).Cells
Set rFound = .Find( _
What:="Remaining", _
after:=.Item(.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
Searchdirection:=xlNext, _
MatchCase:=False)
If Not rFound Is Nothing Then
sFoundFirst = rFound.Address
Do
rFound.Offset(1, 0).Resize( _
2, 1).EntireRow.Insert _
Shift:=xlShiftDown
Set rFound = .FindNext(after:=rFound)
Loop Until rFound.Address = sFoundFirst
Set rFound = Nothing
End If
End With
End If
End With
Next ws
End Sub