• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Error Handling problem

Abhijeet

Active Member
Hi In this code please tell me Error handling if Data is not found in Column D then gives me message No data found & macro will stop.


Sub Abhijeet_20499()
Dim CritRange As Range, Extract As Range
Dim ws As Worksheet

'Where does output go?
Set ws = Worksheets("On call")
Worksheets(1).Activate
Set CritRange = Range("D1", Range("D1").End(xlDown))

ws.Activate
Range("a1").CurrentRegion.ClearContents
Set Extract = Range("A1")
'Unique Records
[CritRange].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=[CritRange], CopyToRange:=Extract, Unique:=True
'Headings
[A1:D1] = Array("Assignment", "Element", "Allowance", "Units")
Range("A2", Range("A2").End(xlDown)).Offset(0, 2) = "Weekday"
Range("A2", Range("A2").End(xlDown)).Offset(0, 3) = "=SUMIFS(units,Assignment,A2,day,""<>""&TEXT(0,""DDDD""),day,""<>""&TEXT(1,""DDDD""))"
Range("A2", Range("A2").End(xlDown)).Copy
Range("a1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Selection.Offset(0, 2) = "Weekend"
Selection.Offset(0, 3) = "=SUMPRODUCT((MATCH(Day,{""Monday"",""Tuesday"",""Wednesday""," & _
"""Thursday"",""Friday"",""Saturday"",""Sunday""},0)>5)*(Assignment=A2),Units)"
Range("a1").End(xlDown).Offset(0, 1).Select
Range(ActiveCell, "b2") = "On Call"

Columns("A:D").AutoFit
Range("A1").Activate
Worksheets("Sheet1").Select
Application.CutCopyMode = False
End Sub
 
Hi Abhijeet,

Try below code:

Code:
Dim k As Long
Set CritRange = Range("D1", Range("D1").End(xlDown))
k = Application.WorksheetFunction.CountA(CritRange)
If k = 0 Then
    MsgBox "No data"
    Exit Sub
End If

in between your code.

Regards,
 
Hi Somrendra
This code not work If No data in Column D then not give message & macro goes till this line Range("a1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
 
If only this code is paste then work but in my code if paste then not work can u please give me whole macro or Code then i will check
Dim k As Long
Set CritRange = Range("D1", Range("D1").End(xlDown))
k = Application.WorksheetFunction.CountA(CritRange)
If k = 0 Then
MsgBox "No data"
Exit Sub
End If
 
Hi Abhijeet ,

There is really no way this code cannot work , unless it is this line :

If k = 0 Then

If you are using the Excel Advanced Filter feature , the header line for the Criteria Range should be present ; I assume when you say there is no data , you mean no criteria have been set ; but even in this case , the header line may still be present. In such a case , obviously the above check will not detect the absence of criteria.

Instead , change the above line to :

If k < 2 Then

This should ensure that if the criteria range has a header and at least one criterion , only then does the code execution proceed further ; if not it will exit.

Narayan
 
@Abhijeet

Just an advise, you are nearing to almost 500 posts, and your post is never clear. Try to make it as clear as possible so as the solution which is made is accurate and consumes less time.

Dumping the problem on a forum in urgency to get the solution is not a right etiquette. Hope you will not maintain such thing in future.

Regards,
 
Back
Top