combine macro

sarfarazbutt

Board Regular
Joined
Jun 10, 2009
Messages
55
Below macro is deleting empty row, I would like to have combine macro which can delete also the rows if text found in first cell "Not found" and top of this row also delete. i.e if row 40 found "Not found" text delete this row and 39 row should be delete. any idea




Option Explicit

Sub DeleteEmptyRows()

Dim LastRow As Long
Dim Cnt As Long
Dim r As Long

Application.ScreenUpdating = False

LastRow = Cells.Find(what:="*", _
after:=Range("A1"), _
LookIn:=xlFormulas, _
lookat:=xlPart, _
searchorder:=xlByRows, _
searchdirection:=xlPrevious, _
MatchCase:=False).Row

For r = LastRow To 1 Step -1
If WorksheetFunction.CountA(Rows(r)) = 0 Then
Rows(r).Delete
Cnt = Cnt + 1
End If
Next r

Application.ScreenUpdating = True

MsgBox Cnt & " rows were deleted.", vbInformation

End Sub
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

b.downey

Active Member
Joined
Oct 16, 2011
Messages
484
Try replacing the following line of your code:

Code:
If (WorksheetFunction.CountA(Rows(r)) = 0) Then

with

Code:
If (WorksheetFunction.CountA(Rows(r)) = 0) Or (Cells(r, "A") = "Not found") Then
 

sarfarazbutt

Board Regular
Joined
Jun 10, 2009
Messages
55
Great, that's make half work done, but still small issue when text found "not found" should be delete two rows
i.e. delete the row if text found "not found" and one row top of this text, I mean if row no 40 has text "not found" then delete the two rows one 40 and and 39.
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,378
Code:
    For r = LastRow To 1 Step -1
        If WorksheetFunction.CountA(Rows(r)) = 0 Then
            Rows(r).Delete
            Cnt = Cnt + 1
        ElseIf Range("A" & r).Value = "Not Found" Then
            Rows(r - 1).Resize(2).Delete
            Cnt = Cnt + 2
        End If
    Next r
 

sarfarazbutt

Board Regular
Joined
Jun 10, 2009
Messages
55

ADVERTISEMENT

Still small issue, see the below screen shoot

before run the macro

Excel Workbook
ABCDEFGHIJKL
16
17Nb. #Room TypeActual Rate
18Res NNameCompany/Agency/Source/GroupArrivalDepart.RNAd/ChdRate CodeSegmentSourceAllocationCxl Reason
19
20
21
22Cancellations For##########
23
24
25
26Not Found
27
28Cancellations For##########
29
30
31
32Not found
33
34Cancellations For##########
35
36
37
38Not found
39
40Cancellations For##########
41
42
43
44Not found
MOEV_CXL_BOOKINGS.RPT



after run the macro

Excel Workbook
ABCDEFGHIJKLM
7Res NNameCompany/Agency/Source/GroupArrivalDepart.RNAd/ChdRate CodeSegmentSourceAllocationCxl ReasonBooker
8Cancellations For##########
9Cancellations For##########
10Cancellations For##########
11Cancellations For##########
12Cancellations For##########
13Cancellations For##########
14Cancellations For##########
15Cancellations For##########
16Cancellations For##########
17Cancellations For##########
18194,499Al Alfelasi, NadaBooking.com01/08/03/08/24/0/0/0/01SE3KC0FLEXPA1B0.00LBR BAR on leisure, incl.mercIAB Ind. Private Booking
19Cancellations For##########
20Cancellations For##########
21Cancellations For##########
22Cancellations For##########
23Cancellations For##########
24Cancellations For##########
25Cancellations For##########
26Cancellations For##########
27Cancellations For##########
28Cancellations For##########
29Cancellations For##########
30Cancellations For##########
MOEV_CXL_BOOKINGS.RPT
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
Is the problem just that some rows above row 18 have been deleted?

If so,

For r = LastRow To 19 Step -1
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,378

ADVERTISEMENT

What's the "small issue"? Do you want the "Cancellations For" rows deleted as well?

Code:
    For r = LastRow To 1 Step -1
        If WorksheetFunction.CountA(Rows(r)) = 0 Or [COLOR="Red"]Range("A" & r).Value = "Cancellations For"[/COLOR] Then
            Rows(r).Delete
            Cnt = Cnt + 1
        ElseIf Range("A" & r).Value = "Not Found" Then
            Rows(r - 1).Resize(2).Delete
            Cnt = Cnt + 2
        End If
    Next r
 

sarfarazbutt

Board Regular
Joined
Jun 10, 2009
Messages
55
the issue is if text "not found" then above row "Cancellations For" should delete, but not any row delete if "not found" text is not in first cell. i.e.

if row 3 text will be "not found" then above row (which is 2) "Cancellations For" should delete, but if any other text/number found above row should not delete.

i believe first loop should delete the empty rows in sheet than above statement applied.
 

sarfarazbutt

Board Regular
Joined
Jun 10, 2009
Messages
55
May be below screen shoot will be understand more

below is export sheet in orginal condition


Excel Workbook
ABCDEFGHIJ
1
2
3Cancellations For
4
5
6Not found
7
8
9
10
11Cancellations For
12123545
13
14Cancellations For
15Not found
16
17Cancellations For
1852412
19
20Cancellations For
21
22
23Not found
24
Sheet1



Below is required format

Excel Workbook
AB
1
2
3Cancellations For
4123545
5Cancellations For
652412
Sheet1
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,378
Code:
Sub DeleteEmptyRows()
    
    Dim LastRow As Long
    Dim Cnt    As Long
    Dim r      As Long
    
    Application.ScreenUpdating = False
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For r = LastRow To 3 Step -1
        If WorksheetFunction.CountA(Rows(r)) = 0 Then
            Rows(r).Delete
            Cnt = Cnt + 1
        End If
    Next r
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For r = LastRow To 3 Step -1
        If LCase(Range("A" & r).Value) = "not found" Then
            Rows(r - 1).Resize(2).Delete
            Cnt = Cnt + 2
        End If
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox Cnt & " rows were deleted.", vbInformation
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,518
Messages
5,596,621
Members
414,081
Latest member
Subaru_Steve

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top