Delete 1 Blank of 2 Consecutive Blank Rows

[hip2b2]

I have a small report but the format is somewhat irregular.

The report is several lines of header text
Followed by 1 or more empty rows
Followed by 1 or more consecutive rows of data
Followed by 1 or more empty rows
etc.

I have been looking for VBA code (with no luck) to reduce the 1 or more empty rows to only 1 empty row separating the different data sets..

As always any help is appreciated.

hip

 

[footoo]

Assuming column A can be used to establish the blank rows :

Sub v()
Dim rng As Range, a As Range
Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(3).Row).SpecialCells(xlCellTypeBlanks)
For Each a In rng.Areas
    If a.Count > 1 Then a(2).Resize(a.Count - 1).EntireRow.Delete
Next
End Sub

 

[Peter_SSs]

Slightly tweaking footoo's code to move the .Areas up one code line & eliminate the need to declare a second range ..

Sub ReduceBlanks()
  Dim rA As Range
  For Each rA In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Areas
    If rA.Rows.Count > 1 Then rA.Resize(rA.Rows.Count - 1).EntireRow.Delete
  Next rA
End Sub

 

[hip2b2]

Peter and footoo

Thank you both for taking the time to provie a solution.

hip

 

[Peter_SSs]

You're welcome. Glad we could help. Thanks for the follow-up.

(Perhaps you could also take a look here?)