VBA to take no action if the first cell in a range is blank

[Sebasti]

Im trying to define a macro to help me remove unwanted rows based on some predefined conditions in each column. From the below example im deleting all the rows other than those rows in column B which has the value Y. Having done that, from Column C i want to delete all those rows other than those has value "Bank" and if there isn't data available after running this script i basically want my macro to Stop running further. I have the below code defined but it gives me the error "Block If without End If". I tried all the possible ways to debug this error but i failed :-(

Appreciate if someone can help me being new to macros..

Sheets("Sheet1").Select
Range("B2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value <> "Y" Then
Selection.EntireRow.Delete
Else: ActiveCell.Offset(1, 0).Select
End If
Loop

If Sheets("Sheet1").Range("B2") = 0 Then
'Do Nothing
Else

Range("C2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value <> "Corp" Then
Selection.EntireRow.Delete
Else: ActiveCell.Offset(1, 0).Select
End If
Loop

If Sheets("Sheet1").Range("c2") = 0 Then
'Do Nothing
Else

Range("D2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value <> "Loan" Then
Selection.EntireRow.Delete
Else: ActiveCell.Offset(1, 0).Select
End If
Loop

End Sub

 

[Somendra Misra]

Hi,

Can you try below code:

Option Explicit

Sub test()
Dim lr As Long

lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range("$A$1:$D$" & lr).AutoFilter Field:=2, Criteria1:="<>Y"
    Range("A2").SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range("$A$1:$D$" & lr).AutoFilter Field:=3, Criteria1:="<>Bank"
    Range("A2").SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
    Range("A2").AutoFilter
End Sub

Regards,

 

[Sebasti]

Hi,

Can you try below code:

Option Explicit

Sub test()
Dim lr As Long

lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range("$A$1:$D$" & lr).AutoFilter Field:=2, Criteria1:="<>Y"
    Range("A2").SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range("$A$1:$D$" & lr).AutoFilter Field:=3, Criteria1:="<>Bank"
    Range("A2").SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
    Range("A2").AutoFilter
End Sub

Regards,

Thanks Mr. Misra, this do well as a workaround for me. but the whole issue is that the data range may even go upto 2000 rows and unfortunately the work book is getting hanged :-(

 

[Somendra Misra]

Well I don't see any problem with 2000 rows of data. This should do it fast.

But try below code.

Option Explicit

Sub test()
Dim lr As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range("$A$1:$D$" & lr).AutoFilter Field:=2, Criteria1:="<>Y"
    Range("A2").SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range("$A$1:$D$" & lr).AutoFilter Field:=3, Criteria1:="<>Bank"
    Range("A2").SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
    Range("A2").AutoFilter
   
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Regards,

 

[Sebasti]

Well I don't see any problem with 2000 rows of data. This should do it fast.

But try below code.

Option Explicit

Sub test()
Dim lr As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range("$A$1:$D$" & lr).AutoFilter Field:=2, Criteria1:="<>Y"
    Range("A2").SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range("$A$1:$D$" & lr).AutoFilter Field:=3, Criteria1:="<>Bank"
    Range("A2").SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
    Range("A2").AutoFilter
  
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Regards,

Works better...Thanks for your Help Misra