Remove row shading

[MHamid]

Hello,

Can anyone help me tweak the code below?
I am using this code to insert a row beneath the header once it finds "Audit_Name".
The code works and it does insert the blank row. However, since the header is shaded blue, I need the new row to be in grey (RGB 217,217,217) OR White, Background 1, Darker 15% ... a light shade of grey. I also need to be Merged and Center from columns B:G and I need it have text that is found in column L (column L is already sorted by various areas) So I need the new row to say something like "NAM" in one section of the header with "Audit_Name" and "ASIA" in the next header section.

So it will be header section1, then subheader section in grey, and then the data for that section (NAM), then header for section 2, subheader section in grey and the data for that section (ASIA).

I need help with the inserted row to convert to grey shading, merge from columns B:G, and label it as what column L has.

Dim lRow As Long, iRow As Long
With Worksheets("Report1")
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For iRow = lRow To 1 Step -1
        If .Cells(iRow, "B").Value = "Audit_Name" Then
            '.Rows(iRow).Resize(RowSize:=8).Insert xlShiftDown
              'insert 8 rows and move current (iRow) row down (xlShiftDown)
              'means: insert 8 rows ABOVE current row (iRow)
            .Rows(iRow + 1).Resize(RowSize:=1).Insert xlShiftDown
        End If
    Next iRow
End With
End Sub

Thank you

 

[Sahitya]

Can you please share me the excel view or attach

 

[MHamid]

Hello,

I am not able to share an excel view or attach.
With the code I shared above I am able to insert a row under each header. However, I need to change the shading to grey and copy the first data from column L as a title in the grey row and merge it from column B to G.

What else can I do to explain what I need without being able to show the excel view?

 

[MARK858]

You can upload the file to a free file hosting site like www.box.com or www.dropbox.com mark it for sharing and post the link in provides in the thread (just make sure you anomilise any confidential information).

 

[MHamid]

Hello,

Those sites are denied by my job. So I can't do it that way.

I was able to figure out how to change the shading in the header and I was able to add a row under each header and shade it gray. However, the entire row is shaded gray instead of just the cells beneath the header. Now I'm just trying to figure out how to get the gray shaded area to be a subheader with the data from column L.
So there are about 3 headers total. Using my original example, the first header will have about 15 items with AMER in column L (AMER is listed 15 times in column L). The second section would have OTHER and the last section would have ASIA. These 3 words are repeated one after the other for however many items there are in the section (15, 10, 20). I just need the first instance to be copied into column B of the added row beneath the row 1 header name "Audit_Name". Any ideas?

Sub Insert_Rows()
Dim LRow As Long, iRow As Long
Dim LastCol As Long
With Worksheets("Report1")
    LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For iRow = LRow To 1 Step -1
        If .Cells(iRow, "B").Value = "Audit_Name" Then
            .Rows(iRow + 1).Resize(RowSize:=1).Insert xlShiftDown
        End If
        
        If .Cells(iRow, "B").Value = "Audit_Name" Then
            .Rows(iRow + 1).Resize(RowSize:=1).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.149998474074526
                    .PatternTintAndShade = 0
                End With
        End If
        
    Next iRow
End With
End Sub

Thank you

 

[MHamid]

Hello,

I found the code below that will find the unique value in column L and will keep just the unique value in L deleting the duplicates. Therefore, the unique values will be in row 3,4, and 5.
I want to be able to add the unique value just beneath the section header.

This is the format of the sheet:
Row 1 is the Main Header
Row 2 is a blank row with gray shading
Row 3-18 is data with AMER duplicated in column L
Row 19 is the Main Header again
Row 20 is a blank row with gray shading
Row 21-30 is data with OTHER duplicated in column L
Row 31 is the Main Header yet again
Row 32 is a blank row with gray shading
Row 33-52 is data with ASIA duplicated in column L

I need the unique value in column L to be added to each row that is shaded gray (in this case rows 2, 20, and 32). But these could be anywhere depending on how much data is in each section every month).

The below code shows the added gray rows (2, 20, and 32):

Sub Insert_Rows()

'Insert L1_Area row after Header
Dim LRow As Long, iRow As Long

With Worksheets("Report1")
    LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For iRow = LRow To 1 Step -1
        If .Cells(iRow, "B").Value = "Audit_Name" Then
            .Rows(iRow + 1).Resize(RowSize:=1).Insert xlShiftDown
        End If
        
        If .Cells(iRow, "B").Value = "Audit_Name" Then
            .Rows(iRow + 1).Resize(RowSize:=1).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.149998474074526
                    .PatternTintAndShade = 0
                End With
        End If
        
    Next iRow
End With
End Sub

This code will find the unique value as mentioned in the beginning of this pos:

Option Explicit
Sub UniqueValues()
Dim ws As Worksheet
Dim uniqueRng As Range
Dim myCol As Long
myCol = 8
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set uniqueRng = GetUniqueValues(ws, myCol)
End Sub

Function GetUniqueValues(ws As Worksheet, col As Long) As Range
Dim firstRow As Long
With ws
    .Columns(col).RemoveDuplicates Columns:=Array(1), Header:=xlNo
    firstRow = 3
    If IsEmpty(.Cells(3, col)) Then firstRow = .Cells(3, col).End(xlDown).Row
    Set GetUniqueValues = Range(.Cells(firstRow, col), .Cells(.Rows.Count, col).End(xlUp))
End With
End Function

How can I combine both codes to get the unique value to be added into the gray rows (2, 20 and 32) in column B?
Am I asking for too much here?

Thank you

 

[MHamid]

Hello,

I actually just figured out a way to get the Category added in Column B of the gray rows.

Dim lr As Long
lr = Range("B" & Rows.Count).End(xlUp).Row
    Range("B1:B" & lr).SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[1]C[6]"
    Selection.Font.Bold = True
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

It may not be a big deal, but would there be a way to get the gray shaded are merged from columns B-G and aligned left via VBA?


Thank you