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