Need to modify code to skip blank rows and headings

Hi Missit,

try if this works for you:

Sub Billing2()

    Dim Data() As Variant
    Dim a As Range, r As Range, i As Long
    Dim SrcWks As Worksheet
    Dim DstWks As Worksheet: Set DstWks = ThisWorkbook.Sheets("Billing Summary")

    For Each SrcWks In ThisWorkbook.Worksheets
        Select Case SrcWks.Name
            Case "Audit Summary", "Accuracy Report Group", "Master Provider List", "Instructions", "Billing Temp", "Audit Temp", "Code_Table", "Billing Summary"
                ' Skip these worksheets
            Case Else
                With SrcWks.Range("A20:I90")
                    ReDim Data(1 To Application.CountA(Intersect(.Columns(3).SpecialCells(2, 1), .Cells)), 1 To 10)
                    For Each a In .Columns(3).SpecialCells(2, 1).Areas  'loops through each area with DoB defined
                        For Each r In Intersect(a.EntireRow, .Cells).Rows   'loops through each row of each area
                            If Application.CountA(r) > 1 Then
                                i = i + 1
                                Data(i, 1) = SrcWks.Range("C4").Value
                                Data(i, 2) = r.Cells(2)
                                Data(i, 3) = r.Cells(3)
                                Data(i, 4) = r.Cells(4)
                                Data(i, 5) = r.Cells(5)
                                Data(i, 6) = r.Cells(6)
                                Data(i, 7) = r.Cells(7)
                                Data(i, 9) = r.Cells(9)
                            End If
                        Next r
                    Next a
                    DstWks.Range("A" & Application.Max(3, DstWks.Cells(Rows.Count, "A").End(xlUp).Row)).Resize(i, 10).Value = Data  'destination
                    i = Empty   'clear before moving to next sheet
                End With
        End Select
    Next SrcWks

End Sub

Best,
Johan

Originally Posted by berlan

Hi Missit,

try if this works for you:

Sub Billing2()

    Dim Data() As Variant
    Dim a As Range, r As Range, i As Long
    Dim SrcWks As Worksheet
    Dim DstWks As Worksheet: Set DstWks = ThisWorkbook.Sheets("Billing Summary")

    For Each SrcWks In ThisWorkbook.Worksheets
        Select Case SrcWks.Name
            Case "Audit Summary", "Accuracy Report Group", "Master Provider List", "Instructions", "Billing Temp", "Audit Temp", "Code_Table", "Billing Summary"
                ' Skip these worksheets
            Case Else
                With SrcWks.Range("A20:I90")
                    ReDim Data(1 To Application.CountA(Intersect(.Columns(3).SpecialCells(2, 1), .Cells)), 1 To 10)
                    For Each a In .Columns(3).SpecialCells(2, 1).Areas  'loops through each area with DoB defined
                        For Each r In Intersect(a.EntireRow, .Cells).Rows   'loops through each row of each area
                            If Application.CountA(r) > 1 Then
                                i = i + 1
                                Data(i, 1) = SrcWks.Range("C4").Value
                                Data(i, 2) = r.Cells(2)
                                Data(i, 3) = r.Cells(3)
                                Data(i, 4) = r.Cells(4)
                                Data(i, 5) = r.Cells(5)
                                Data(i, 6) = r.Cells(6)
                                Data(i, 7) = r.Cells(7)
                                Data(i, 9) = r.Cells(9)
                            End If
                        Next r
                    Next a
                    DstWks.Range("A" & Application.Max(3, DstWks.Cells(Rows.Count, "A").End(xlUp).Row)).Resize(i, 10).Value = Data  'destination
                    i = Empty   'clear before moving to next sheet
                End With
        End Select
    Next SrcWks

End Sub

Best,
Johan

Hi, I tried sending you an answer on this, but I don't know where it went. It works fine, except that I forgot to mention that some of the pages may be blank. When that happens, the code breaks. Is there a way we can skip those pages that don't have any data in them?

Thanks so much for all your help.

Carole

Rather than mess with your code why not just clean up the billing summary sheet.
I wrote this sub and it tested okay. Since you have that cool button where you can repopulate the billing summary sheet you can test it out for yourself.

Good Luck!

Sub CleanUpBillingSummary()

Dim lr As Long
Dim ws As Worksheet
Dim c As Long
Dim NotDesired()

Application.ScreenUpdating = False

NotDesired = Array("Office/OutPatient", "TOTALS", "Hospital", "Re-Audit")

Set ws = Worksheets("Billing Summary")
ws.Activate
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row

With ws
    For c = lr To 3 Step -1
            If UBound(Filter(NotDesired, .Cells(c, 2).Value)) = 0 Or .Cells(c, 2).Value = "" Then
                .Rows(c).EntireRow.Delete
            End If
    Next c
End With

Application.ScreenUpdating = True
    
End Sub

For skipping the heading, change this line

 For n = 1 To SrcRng.Rows.Count


INTO

 For n = 2 To SrcRng.Rows.Count