ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   No Interior Color Macro (https://www.excelbanter.com/excel-discussion-misc-queries/183326-no-interior-color-macro.html)

simplymidori[_2_]

No Interior Color Macro
 
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

OssieMac

No Interior Color Macro
 
Try inserting the following code immediately after the line where you insert
the rows.

rFound.Offset(1, 0).Resize( _
2, 1).EntireRow.Interior. _
PatternColorIndex = xlColorIndexNone
--
Regards,

OssieMac


"simplymidori" wrote:

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



All times are GMT +1. The time now is 11:16 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com