Let Joy be unconfined!! code works like a dream. Thanks for all your help :o Just in time for deadline tomorrow.
Final code:
Code:Sub Jan() '*********************** January KPI Report ************************** Dim wksRawData As Worksheet Dim wksHKKot As Worksheet Dim wksHKHam As Worksheet Dim wksXMNSHAHam As Worksheet Dim rngRawData As Range Dim lngCount As Long Dim Jan As Date Dim Feb As Date Dim HK As String Dim KT As String Dim HAM As String Dim XMN As String Dim SHA As String Dim LastRow As Long Dim Eta_Col As String Dim Pol_Col As String Dim PoD_Col As String Set wksRawData = Worksheets("Raw Data") Set wksHKKot = Worksheets("HKG to Kotka") Set wksHKHam = Worksheets("HKG to Hamburg") Set wksXMNSHAHam = Worksheets("XMN | SHA to Hamburg") Jan = #1/1/2012# Feb = #1/2/2012# HK = "Hong Kong" KT = "Kotka" HAM = "Hamburg" XMN = "Xiamen" SHA = "Shanghai" With wksRawData If .AutoFilterMode Then .AutoFilterMode = False 'remove autofilter LastRow = .Range("L" & .Rows.Count).End(xlUp).Row Set rngRawData = .Range("a5:w" & LastRow) 'set the range Eta_Col = "'" & .Name & "'!L6:L" & LastRow Pol_Col = "'" & .Name & "'!n6:n" & LastRow PoD_Col = "'" & .Name & "'!o6:o" & LastRow End With ' **************** Hong Kong to Kotka *********************************** 'count whether any shipment exist in January from Hong Kong to Kotka lngCount = Evaluate("sumproduct(--(text(" & Eta_Col & ",""mmyy"")=text(""" & Jan & """+0,""mmyy"")),--(" & Pol_Col & "=""" & HK & """),--(" & PoD_Col & "=""" & KT & """))") 'if exist If lngCount Then With rngRawData .AutoFilter field:=12, Criteria1:=">=" & Jan, Operator:=xlAnd, _ Criteria2:="<" & Feb, Operator:=xlAnd .AutoFilter field:=14, Criteria1:=HK .AutoFilter field:=15, Criteria1:=KT Set rng = .Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(12) End With wksHKKot.Range("A11:W40").ClearContents rng.Copy wksHKKot.Range("A11") wksRawData.ShowAllData Else wksHKKot.Range("A11:W40").ClearContents MsgBox "No Shipments from Hong Kong to Kotka in January" End If ' ************************************************************************* ' **************** Hong Kong to Hamburg *********************************** 'reset lngCount lngCount = 0 'count whether any shipment exist in January from Hong Kong to Hamburg lngCount = Evaluate("sumproduct(--(text(" & Eta_Col & ",""mmyy"")=text(""" & Jan & """+0,""mmyy"")),--(" & Pol_Col & "=""" & HK & """),--(" & PoD_Col & "=""" & HAM & """))") 'if exist If lngCount Then With rngRawData .AutoFilter field:=12, Criteria1:=">=" & Jan, Operator:=xlAnd, _ Criteria2:="<" & Feb, Operator:=xlAnd .AutoFilter field:=14, Criteria1:=HK .AutoFilter field:=15, Criteria1:=HAM Set rng = .Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(12) End With wksHKHam.Range("A11:W40").ClearContents rng.Copy wksHKHam.Range("A11") wksRawData.ShowAllData Else wksHKHam.Range("A11:W40").ClearContents MsgBox "No Shipments from Hong Kong to Hamburg in January" End If ' ************************************************************************* ' **************** Xiamen | Shanghai to Hamburg *********************************** 'reset lngCount lngCount = 0 'count whether any shipment exist in January from Xiamen and Shanghai to Hamburg lngCount = Evaluate("sumproduct(--(text(" & Eta_Col & ",""mmyy"")=text(""" & Jan & """+0,""mmyy"")),--(" & Pol_Col & "=""" & SHA & """)+(" & Pol_Col & "=""" & XMN & """),--(" & PoD_Col & "=""" & HAM & """))") 'if exist If lngCount Then With rngRawData .AutoFilter field:=12, Criteria1:=">=" & Jan, Operator:=xlAnd, _ Criteria2:="<" & Feb, Operator:=xlAnd .AutoFilter field:=14, Criteria1:=SHA, Operator:=xlOr, _ Criteria2:=XMN .AutoFilter field:=15, Criteria1:=HAM Set rng = .Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(12) End With wksXMNSHAHam.Range("A11:W40").ClearContents rng.Copy wksXMNSHAHam.Range("A11") wksRawData.ShowAllData Else wksXMNSHAHam.Range("A11:W40").ClearContents MsgBox "No Shipments Xiamen or Shanghai to Hamburg in January" End If ' ************************************************************************* Set wksRawData = Nothing Set wksHKKot = Nothing Set wksHKHam = Nothing Set wksXMNSHAHam = Nothing End Sub




Reply With Quote

Bookmarks