Delete blank rows between texts

[Panoos64]

Hi to all, I would like to delete the blank rows between the last fulfill cell in col. “A” with text “Grand Total” and “Departments Totals”using a VBA code. Please see below an extract of my data by which the range of rows which should delete are 155:159. One row, 154 should remain and therefore that the rows are not stably but variable. I present below an extract of original data and expected result. Thank you all in advance.


Original data

	A​	B​
148​	Grand Total​	​
149​
150​	Grand Total​
151​
152​
153​	Grand Total​
154​
155​
156​
157​
158​
159​
160​	Departments Totals​

Expected result

	A​	B​
148​	Grand Total​	​
149​
150​	Grand Total​
151​
152​
153​	Grand Total​
154​
160​	Departments Totals​
​	​
​	​
​	​
​	​
​	​

 

[dougmarkham]

Hi Panoos64,

You can use VBA to delete blank rows easily enough. I've included this link to show you the various method: Deleting a row with VBA

However, you can also Select a range and delete all blank rows in that range. This can be quite useful code to have.

'This VBA deletes all blank rows in a used range (you can change the range selected e.g., by ActiveSheet.Range("A1:A10").Select

Sub usedR()
ActiveSheet.UsedRange.Select
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Kind regards,

Doug.

 

[Panoos64]

Hi dougmark, Thank you for your code and your support. The code works but i cannot adapt it to my data. The point is that, your code delete any blank row in a specific range or rows e.g. "A55:A80" but therefore on my data should delete any blank row between the last fulfill row with text "Grand Total and the last fulfill row with text "Departments Totals". Any other blank rows should remain unaffected. However i appreciated your attempt to resolve my issue and i express my thanks. Hv a great day

 

[dougmarkham]

Hi dougmark, Thank you for your code and your support. The code works but i cannot adapt it to my data. The point is that, your code delete any blank row in a specific range or rows e.g. "A55:A80" but therefore on my data should delete any blank row between the last fulfill row with text "Grand Total and the last fulfill row with text "Departments Totals". Any other blank rows should remain unaffected. However i appreciated your attempt to resolve my issue and i express my thanks. Hv a great day

Hi Panoos64,

That code was just for your future use.
The link I sent you tells you how to delete specific rows using VBA.

For instance, if you wish to delete rows 2, 3, 5, and 9, then, you can write a delete line for '2 and 3', then for 5 and 9.

You should be able to delete specific rows in data that regularly arrives unchanged in format / layout.
If your chart changes each time you get it, then we'd need to refer to values within the column and offset to limit the delete range to the row above the one you wish to keep etc.
Please let me know if this is the case?

Kind regards,

Doug.

 

[Panoos64]

Hi Doug again! Thank u for your above clarify. However last paragraph is what i requested. The blank rows change each time when i get data. The range of rows which should delete are within the last fulfill text "Grand Total" and the text "Departments Totals" in col. "A". So the code should run through col "A" and where find the last cell text "Grand Total" and below the text "Departments Totals" should delete the rows within the above texts. Thank u once again for your support. Hv a nice day

 

[dougmarkham]

Hi Doug again! Thank u for your above clarify. However last paragraph is what i requested. The blank rows change each time when i get data. The range of rows which should delete are within the last fulfill text "Grand Total" and the text "Departments Totals" in col. "A". So the code should run through col "A" and where find the last cell text "Grand Total" and below the text "Departments Totals" should delete the rows within the above texts. Thank u once again for your support. Hv a nice day

Hi Panoos64,

Thanks for clarifying.

I have tested this code below: if I've understood you correctly, this should suffice.
Please change any worksheet references that differ from my workbook.

Sub FindRowsAndDelete()
   
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
   
    Dim ActCell As Range
    Dim ActCel As Range
    Dim rng As Range
    Dim FindString As String
   
    Worksheets("Sheet1").Activate
   
    'Finds cell in column A with Department Totals in it and selects it.
    FindString = "Department Totals"
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set rng = .Find(what:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
                Application.GoTo rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
   
    'Set selected cell as the range object: ActCel
    Set ActCel = Application.ActiveCell.Offset(0, 0)
   
    'Do loop with condition that if statement only happens if the cell two cells above ActCel is blank
    Do While Application.ActiveCell.Offset(-2, 0).Value = ""
   
    If Application.ActiveCell.Offset(-2, 0).Value = "" Then
        Application.ActiveCell.Offset(-2, 0).Select
        Application.ActiveCell.EntireRow.Select
        Selection.EntireRow.Delete Shift:=xlUp
    Else
    GoTo AA
    End If
    ActCel.Select
    Loop
   
AA:
  
    MsgBox "Complete!", vbExclamation, "Delete Rows above Department Totals"
  
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
   
End Sub

Kind regards,

Doug.

 

[Panoos64]

Thank u Doug! The code works perfect and based to my data. Thank u also for your time spent for my project. In addition i express my apologies if i didn't present, code's right procedure on my first post. Hv a lovely day!