Need help: if there is no data in 2nd visible row(after filters), call other macro.

aman2059

Board Regular
Joined
Jan 17, 2016
Messages
75
Hi,


Could anyone please suggest me the code to check if there in particular sheet, is there any data in 2nd visible row(after filters) and if there is no data, then 'call other macro'

I am using below code But somehow when it goes to the 'Bold' line, it directly exits the macro. I am not sure why is happening. Please help.

Code:
    With ActiveSheet.usedrange.SpecialCells(12)
        [B]If .Areas.Count = 1 And .Areas(1).Rows.Count = 1 Then Exit Sub[/B]
        If .Areas(1).Rows.Count = 1 Then
            If Application.CountA(.Areas(2).Rows(1)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
Else
    If Application.CountA(.Areas(1).Rows(2)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
        End If
    End With

Thank you in advance
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
The system on finding no data generates an error, you have no visible error trapping and the macro can't continue, so crashes out incomplete
 
Upvote 0
Hi Mole999,

Thank you. Could you please help me to resolve this problem. I am not sure how to come out of it.

Please help!!
 
Upvote 0
it really depends on your circumstances, the best would be to test if it would be blank and step over the macro but if you have committed to it something like On Error GoTo 0 or On Error Resume Next

like
Code:
[COLOR="#FF0000"]On Error Resume Next[/COLOR]
    With ActiveSheet.usedrange.SpecialCells(12)
        If .Areas.Count = 1 And .Areas(1).Rows.Count = 1 Then Exit Sub
        If .Areas(1).Rows.Count = 1 Then
            If Application.CountA(.Areas(2).Rows(1)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
Else
    If Application.CountA(.Areas(1).Rows(2)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
        End If
    End With

you'll need to test that stepping through to see if it delivers what is acceptable (use a copy of the workbook)
 
Upvote 0
I can explain you the situation - I have to filter the data first in the particular sheet, and after filtering if there is no data in the sheet, it should call another macro and if there is data in the sheet, the macro should keep on running and go to the another line to copy data and paste it in another workboook. I hope you understand.

Code:
Sub pastingdataafrica()

    Dim x As Long

  Range("T1").Select
    ActiveSheet.Range(("A1"), Selection.End(xlDown)).AutoFilter field:=20, Criteria1:="", Operator:=xlAnd

    With ActiveSheet.usedrange.SpecialCells(12)
        If .Areas.Count = 1 And .Areas(1).Rows.Count = 1 Then Exit Sub
        If .Areas(1).Rows.Count = 1 Then
            If Application.CountA(.Areas(2).Rows(1)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
Else
    If Application.CountA(.Areas(1).Rows(2)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
        End If
    End With
   
    With ActiveSheet
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        .Range("C2").Resize(x).SpecialCells(xlCellTypeVisible).Copy
    End With
    
    Workbooks("Exceptions Report.xlsx").Sheets("User Email ID Missing").Range("A2").PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False

End Sub
 
Upvote 0
I don't think it is an error because it still go to line.

Code:
If .Areas.Count = 1 And .Areas(1).Rows.Count = 1 Then Exit Sub

and then Exit sub because it is written exit sub. However there is a data in first row of my sheet and then after filter there is no data in any other row except 1st row.



Code:
On Error Resume Next
    With ActiveSheet.usedrange.SpecialCells(12)
  [B]      If .Areas.Count = 1 And .Areas(1).Rows.Count = 1 Then Exit Sub[/B]
        If .Areas(1).Rows.Count = 1 Then
            If Application.CountA(.Areas(2).Rows(1)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
Else
    If Application.CountA(.Areas(1).Rows(2)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
        End If
    End With
 
Upvote 0
I know of special cells, but not great at dealing with the code

maybe
Code:
sub escaperoutine
On Error Resume Next
    With ActiveSheet.usedrange.SpecialCells(12)
        If .Areas.Count = 1 And .Areas(1).Rows.Count = 1 Then Exit Sub
        If .Areas(1).Rows.Count = 1 Then
            If Application.CountA(.Areas(2).Rows(1)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
Else
    If Application.CountA(.Areas(1).Rows(2)) = 0 Then
        Call pastingcounselordataKeralaexcept21
        Exit Sub
    End If
        End If
    End With

Code:
Sub pastingdataafrica()

    Dim x As Long

  Range("T1").Select
    ActiveSheet.Range(("A1"), Selection.End(xlDown)).AutoFilter field:=20, Criteria1:="", Operator:=xlAnd

    With ActiveSheet.usedrange.SpecialCells(12)
[COLOR="#FF0000"]
escaperoutine[/COLOR]
     
    With ActiveSheet
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        .Range("C2").Resize(x).SpecialCells(xlCellTypeVisible).Copy
    End With
    
    Workbooks("Exceptions Report.xlsx").Sheets("User Email ID Missing").Range("A2").PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False

End Sub

untested
 
Upvote 0
This is not working :( . Need help

Maybe you can provide different coding for the same criteria as I explained above.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,198
Members
448,554
Latest member
Gleisner2

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
Back
Top