Color Filling empty Rows in a Range and Numbering Empty Rows

[tlaltmey]

I'd like to fill the empty rows in a table gray but from A:G.

Currently I have the following:
' Colors the empty rows gray

Dim rng As Range

 On Error Resume Next
 Set rng = Range("A1:G").SpecialCells(xlCellTypeBlanks)
 On Error GoTo 0
 If Not rng Is Nothing Then
 
 rng.Interior.ColorIndex = 15
End If

This fills the entire row gray rather than stopping at the G column.

Additionally, I'd like to number empty rows beginning in the A column up until the end of the data. The issue I have is that the table will be dynamic (Could go from Row 1 to Row 40 one week and then from Row 1 to Row 70 the next week). I'm having a hard time trying to figure out how to number the data within the table but stopping before numbering an entire sheet.

Overall Code here:

Sub Button1_Click()

' Deletes Columns Unnecessary Data

   Sheets("Sheet1").Range("B:B, D:D, I:M").EntireColumn.Delete

' Sorts Data in Alpha Numerical Order using Column "D" 

Range("D1").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes


' Adds a Spaced Row After each Column D Line is found to be Different

Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row To 2 Step -1
    If Left(Cells(lRow, "D"), 7) <> Left(Cells(lRow - 1, "D"), 7) Then
        Rows(lRow).EntireRow.Insert
        
        ' Adds a gray filled bar in empty rows
        Rows(lRow).Interior.ColorIndex = 15
    End If
Next lRow

' Colors the empty rows gray

Dim rng As Range

 On Error Resume Next
 Set rng = Range("A1:G").SpecialCells(xlCellTypeBlanks)
 On Error GoTo 0
 If Not rng Is Nothing Then
 
 rng.Interior.ColorIndex = 15
End If

' Auto Fits Rows and Columns based off of the data
Sheets(1).UsedRange.Columns.AutoFit
Sheets(1).UsedRange.Rows.AutoFit
     
' Creates the Notes Section in G1
Range("G1") = "Notes"

' Creates a border around the data to make it look pretty :)

Range("A1:G" & Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous


Application.ScreenUpdating = True


End Sub

 

[offthelip]

You can number the empty rows by using an equation: assuming the list of data in column B with various gaps put this equation in A1 and copy it down it will number the gaps:

=IF(B1="",ROW()-COUNTA(B$1:B1),"")

You could use condtional formatting to make the blank cells grey

 

[tlaltmey]

You can number the empty rows by using an equation: assuming the list of data in column B with various gaps put this equation in A1 and copy it down it will number the gaps:

=IF(B1="",ROW()-COUNTA(B$1:B1),"")

You could use condtional formatting to make the blank cells grey

I'm not sure how conditional formatting will solve this issue, as the data doesn't get implemented with empty rows. The empty rows are created after running the macro. Same issue with the numbering. The empty rows are added after, which I need a way to stop the numbering dynamically.

 

[offthelip]

to solve the probelm of coloring the entire row make this change:

Dim lRow As Long

For lRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row To 2 Step -1
    If (Cells(lRow, "D") <> (Cells(lRow - 1, "D"))) Then
        Rows(lRow).EntireRow.Insert
  
        ' Adds a gray filled bar in empty rows
    Range(Cells(lRow, 1), Cells(lRow, 7)).Interior.ColorIndex = 15  ' change this line
    End If
Next lRow

to add numbering in column A for each blank in column D add this at the bottom

lastrow = Cells(Cells.Rows.Count, "D").End(xlUp).Row


inarr = Range(Cells(1, 4), Cells(lastrow, 4))
outarr = Range(Cells(1, 1), Cells(lastrow, 1))
Range(Cells(2, 1), Cells(lastrow, 1)) = "" ' clear column A to put numbering in
indi = 1
For i = 2 To lastrow
  If inarr(i, 1) = "" Then
   outarr(i, 1) = indi
   indi = indi + 1
  End If
Next i
Range(Cells(1, 1), Cells(lastrow, 1)) = outarr

 

[tlaltmey]

to solve the probelm of coloring the entire row make this change:

Dim lRow As Long

For lRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row To 2 Step -1
    If (Cells(lRow, "D") <> (Cells(lRow - 1, "D"))) Then
        Rows(lRow).EntireRow.Insert
 
        ' Adds a gray filled bar in empty rows
    Range(Cells(lRow, 1), Cells(lRow, 7)).Interior.ColorIndex = 15  ' change this line
    End If
Next lRow

to add numbering in column A for each blank in column D add this at the bottom

lastrow = Cells(Cells.Rows.Count, "D").End(xlUp).Row


inarr = Range(Cells(1, 4), Cells(lastrow, 4))
outarr = Range(Cells(1, 1), Cells(lastrow, 1))
Range(Cells(2, 1), Cells(lastrow, 1)) = "" ' clear column A to put numbering in
indi = 1
For i = 2 To lastrow
  If inarr(i, 1) = "" Then
   outarr(i, 1) = indi
   indi = indi + 1
  End If
Next i
Range(Cells(1, 1), Cells(lastrow, 1)) = outarr

This works perfectly. Thank you!

 

[MARK858]

For the colouring part if you wanted to keep your original syntax...

    Dim rng As Range

    On Error Resume Next
    Set rng = Range("A1:G" & Columns("A:G").Find("*", , xlValues, , xlByRows, xlPrevious).Row).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    If Not rng Is Nothing Then
        rng.Interior.ColorIndex = 15
    End If