don't copy filtered data if no active cells

Hello All,

I am experiencing a problem with some code I am using to filter a spread sheet by Date range and by another criteria. The code works great for the main part but I am hitting a serious problem when there are no active rows i.e. there are no cells in the date range. When this happens instead of not copy any rows over to my other sheet within the same workbook, it pastes ALL the rows from the Raw Data. I tried using an if statement to say if rng <> "" then carry on with code else msg box "No data to copy" but I cant get this to work. Any ideas?

Code:

---

Sub Jan()
' ******************* January KPI ***************************************

    Dim Jan As Date
    Dim Feb As Date
    Dim rng As Range
   
    Set rng = ActiveSheet.AutoFilter.Range
   
    Jan = #1/1/2012#
    Feb = #1/2/2012#
   
    ' Filter rows to January sailings only
    Range("K5").Select
    Selection.AutoFilter
    Selection.AutoFilter field:=11, Criteria1:=">=" & Jan, Operator:=xlAnd, _
    Criteria2:="<" & Feb, Operator:=xlAnd
   
    ' Filter rows to HKG to Kotka only
    Selection.AutoFilter field:=14, Criteria1:="Hong Kong"
    Selection.AutoFilter field:=15, Criteria1:="Kotka"
   
    'Select sheet "HKG to Kotka and clear old data
    Sheets("HKG to Kotka").Select
    Range("A11:W40").ClearContents
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
   
    'Go back to Raw Data sheet
    Sheets("Raw Data").Select
   
    'Copy the active rows to HK to Kotka sheet
    rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
    Destination:=Worksheets("HKG to Kotka").Range("A11")
 
    'Filter to Show All
    ActiveSheet.ShowAllData

---

gratefully appreciate any help. Thank you.

I am having a little sucess with Specialcells(xlVisible), but im note sure who to use this within my code to achieve my goal.

Hi

Try

Code:

---

Sub Jan()
' ******************* January KPI ***************************************
   
    Dim wksRawData  As Worksheet
    Dim wksDest    As Worksheet
    Dim rngRawData  As Range
    Dim lngCount    As Long
   
    Dim Jan As Date
    Dim Feb As Date
    Dim rng As Range
   
   
    Set wksRawData = Worksheets("Raw Data")
    Set wksDest = Worksheets("HKG to Kotka")
   
    With wksRawData
        If .AutoFilterMode Then .AutoFilterMode = False 'remove autofilter
        Set rngRawData = .Range("a5:w" & .Range("k" & .Rows.Count).End(xlUp).Row) 'set the range
    End With
   
    Jan = #1/1/2012#
    Feb = #1/2/2012#
   
    With Application.WorksheetFunction
        'count whether jan dates are exist
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), ">" & Feb)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, Criteria1:=">=" & Jan, Operator:=xlAnd, _
                    Criteria2:="<" & Feb, Operator:=xlAnd
            .AutoFilter field:=14, Criteria1:="Hong Kong"
            .AutoFilter field:=15, Criteria1:="Kotka"
            Set rng = .Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(12)
        End With
        wksDest.Range("A11:W40").ClearContents
        rng.Copy wksDest.Range("A11")
        wksRawData.ShowAllData
    End If
   
End Sub

---

Thanks Admin, the code looks great but I am still in the same position. When there are no cells to copy after filter i get the error "No cells were found" but in the case where no active cells are filtered I need to move on to the next bit of code instead if stopping the sub. Thanks for your help :)

Code:

---

Set rng = .Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(12)

---

Hi

I guess there there would no "Hong Kong" or "Kotka" in the range.

Declare two variables and do a countif for those 2 criterias like I did for date.

Thanks Admin, I have amended my code as follows but third part of sub doesn't work and I can't figure out why. The full code of the sub is:

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
   
    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
        Set rngRawData = .Range("a5:w" & .Range("k" & .Rows.Count).End(xlUp).Row) 'set the range
    End With
   
    ' **************** Hong Kong to Kotka ***********************************
    With Application.WorksheetFunction
        'count whether any shipment exist in January from Hong Kong to Kotka
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), "<" & Feb) _
        & .CountIf(wksRawData.Columns(14), "=" & HK) _
        & .CountIf(wksRawData.Columns(15), "=" & KT)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, 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
        MsgBox "No Shipments from Hong Kong to Kotka in January"
    End If
  ' *************************************************************************
   
 ' **************** Hong Kong to Hamburg ***********************************
    With Application.WorksheetFunction
        'count whether any shipment exist in May from Hong Kong to Hamburg
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), "<" & Feb) _
        & .CountIf(wksRawData.Columns(14), "=" & HK) _
        & .CountIf(wksRawData.Columns(15), "=" & HAM)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, 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
        MsgBox "No Shipments from Hong Kong to Hamburg in January"
    End If
  ' *************************************************************************
 
  ' **************** Xiamen | Shanghai to Hamburg ***********************************
 
    With Application.WorksheetFunction
        'count whether any shipment exist in May from Xiamen and Shanghai to Hamburg
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), "<" & Feb) _
        & .CountIf(wksRawData.Columns(14), "=" & XMN) _
        & .CountIf(wksRawData.Columns(15), "=" & HAM)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, Criteria1:=">=" & Jan, Operator:=xlAnd, _
                    Criteria2:="<" & Feb, Operator:=xlAnd
            .AutoFilter field:=14, Criteria1:=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
        MsgBox "No Shipments from Hong Kong to Hamburg in January"
    End If
   
  ' *************************************************************************
   
    Set wksRawData = Nothing
    Set wksHKKot = Nothing
    Set wksHKHam = Nothing
    Set wksXMNSHAHam = Nothing
   
End Sub

---

the code that's not working is after '***** Xiamen | Shanghai to Hamburg *******

I'm almost certainly doing something stupid but I am stumped :) cheers.

Hi

try

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
   
    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
        Set rngRawData = .Range("a5:w" & .Range("k" & .Rows.Count).End(xlUp).Row) 'set the range
    End With
   
    ' **************** Hong Kong to Kotka ***********************************
    With Application.WorksheetFunction
        'count whether any shipment exist in January from Hong Kong to Kotka
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), ">" & Feb)
        lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & HK)
        lngCount = lngCount * .CountIf(wksRawData.Columns(15), "=" & KT)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, 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
        MsgBox "No Shipments from Hong Kong to Kotka in January"
    End If
  ' *************************************************************************
   
 ' **************** Hong Kong to Hamburg ***********************************
    'reset lngCount
    lngCount = 0
    With Application.WorksheetFunction
        'count whether any shipment exist in May from Hong Kong to Hamburg
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), ">" & Feb)
        lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & HK)
        lngCount = lngCount * .CountIf(wksRawData.Columns(15), "=" & HAM)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, 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
        MsgBox "No Shipments from Hong Kong to Hamburg in January"
    End If
  ' *************************************************************************
 
  ' **************** Xiamen | Shanghai to Hamburg ***********************************
    'reset lngCount
    lngCount = 0
    With Application.WorksheetFunction
        'count whether any shipment exist in May from Xiamen and Shanghai to Hamburg
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), ">" & Feb)
        lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & XMN)
        lngCount = lngCount * .CountIf(wksRawData.Columns(15), "=" & HAM)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, Criteria1:=">=" & Jan, Operator:=xlAnd, _
                    Criteria2:="<" & Feb, Operator:=xlAnd
            .AutoFilter field:=14, Criteria1:=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
        MsgBox "No Shipments from Hong Kong to Hamburg in January"
    End If
   
  ' *************************************************************************
   
    Set wksRawData = Nothing
    Set wksHKKot = Nothing
    Set wksHKHam = Nothing
    Set wksXMNSHAHam = Nothing
   
End Sub

---

Thanks Admin but still get the same error "No cells were found" so its not saying the lngcount exists though it does. Also its not picking up on the else msgbox for some reason?

Hi

Could you attach a sample workbook? Remove the sensitive data and put some dummy values.

Thanks Admin, I tweeked a couple of things and now works brilliant. second filter criteria was > Feb and should have been < Feb Thanks for All you help. Final code that worked:=

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
   
    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
        Set rngRawData = .Range("a5:w" & .Range("k" & .Rows.Count).End(xlUp).Row) 'set the range
    End With
   
    ' **************** Hong Kong to Kotka ***********************************
    With Application.WorksheetFunction
        'count whether any shipment exist in January from Hong Kong to Kotka
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), ">" & Feb)
        lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & HK)
        lngCount = lngCount * .CountIf(wksRawData.Columns(15), "=" & KT)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, 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
        MsgBox "No Shipments from Hong Kong to Kotka in January"
    End If
  ' *************************************************************************
   
 ' **************** Hong Kong to Hamburg ***********************************
    'reset lngCount
    lngCount = 0
    With Application.WorksheetFunction
        'count whether any shipment exist in January from Hong Kong to Hamburg
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), ">" & Feb)
        lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & HK)
        lngCount = lngCount * .CountIf(wksRawData.Columns(15), "=" & HAM)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, 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
        MsgBox "No Shipments from Hong Kong to Hamburg in January"
    End If
  ' *************************************************************************
 
  ' **************** Xiamen | Shanghai to Hamburg ***********************************
    'reset lngCount
    lngCount = 0
    With Application.WorksheetFunction
        'count whether any shipment exist in January from Xiamen and Shanghai to Hamburg
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & Jan) - .CountIf(wksRawData.Columns(11), "<" & Feb)
        lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & SHA)
        lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & XMN)
        lngCount = lngCount * .CountIf(wksRawData.Columns(15), "=" & HAM)
    End With
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, 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
        MsgBox "No Shipments from Hong Kong to Hamburg in January"
    End If
   
  ' *************************************************************************
   
    Set wksRawData = Nothing
    Set wksHKKot = Nothing
    Set wksHKHam = Nothing
    Set wksXMNSHAHam = Nothing
   
End Sub

---

Oh Dear :( Just when I thought it was sorted, I come across a month that doesn't have any data to copy and so have found out the lngcount to see if data does exist is not working. Any idea?

Code:

---

' **************** Hong Kong to Hamburg ***********************************
    'reset lngCount
    lngCount = 0
    With Application.WorksheetFunction
        'count whether any shipment exist in May from Hong Kong to Hamburg
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & May) _
        - .CountIf(wksRawData.Columns(11), ">" & Jun)
        lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & HK)
        lngCount = lngCount * .CountIf(wksRawData.Columns(15), "=" & HAM)
    End With

---

:):):) panic over. I replaced '*' with '&' now picks up if blank. Thanks again.

Hi

Ideally the * should be there. The logic is, it multiplies each countif results. So if any countif returns 0, then the code won't work.

Very good point. I ran through the code line by line and found the lngCount was a - figure so changed code to the following. Do you think it would be ok? if lngCount > 0 copy data. That way only when there is at least 1 line of data will code copy the data else it will show message. TBH my brain is getting a little fried.

Code:

---

With Application.WorksheetFunction
        'count whether any shipment exist in May from Hong Kong to Kotka
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & May) _
        - .CountIf(wksRawData.Columns(11), ">" & Jun) _
        * .CountIf(wksRawData.Columns(14), "=" & HK) _
        * .CountIf(wksRawData.Columns(15), "=" & KT)
    End With
   
    'if exist
    If lngCount > 0 Then

---

Thank you for being patient.

Hi

Not sure how a -figure comes.

split each count on different line of code rather than puting a single line.

Code:

---

With Application.WorksheetFunction
    'count whether any shipment exist in May from Hong Kong to Kotka
    lngCount = .CountIf(wksRawData.Columns(11), ">=" & May) - .CountIf(wksRawData.Columns(11), ">" & Jun)
    lngCount = lngCount * .CountIf(wksRawData.Columns(14), "=" & HK)
    lngCount = lngCount * .CountIf(wksRawData.Columns(15), "=" & KT)
End With

---

Thanks Admin. I have spent a few hours on it but can't get it to work. the above code won't work :( The problem is I have to run the same code for each month of the year to copy data for shipment in that month for shipments from port1 to port2. The code we have filters the code to the month which is great but the problem with the code is :

Code:

---

With Application.WorksheetFunction
        'count whether any shipment exist in May from Hong Kong to Kotka
        lngCount = .CountIf(wksRawData.Columns(11), ">=" & May) _
        - .CountIf(wksRawData.Columns(11), ">" & Jun) _
        * .CountIf(wksRawData.Columns(14), "=" & HK) _
        * .CountIf(wksRawData.Columns(15), "=" & KT)
    End With

---

the main problem is that when using 'CountIf(wksRawData.Columns' this uses the whole sheet as range not just the month in question. So I need to filter month, then only look for shipments from port1 to port 2 within the month range.

Perhaps we can check for shipments in the month (which we have) then set that as a range. We can then use that range to filter the ports and copy the data. Not sure how to code that though :(

If you could attach a sample workbook, I'll have a look.

Thanks admin. Attaching now. The attached uses the month on June as the example. To summerise, it checks the whole sheet to see if any shipments but I need it to only check the date range (June). Thanks again :)Attachment 424

I'm very nearly there. I just need the following code corrected so it only checks column 14 of visible rows.

Code:

---

lngCount = 0
    With Application.WorksheetFunction
        'count whether any shipment exist in June from Hong Kong to Kotka
        lngCount = rngRawData.SpecialCells(xlCellTypeVisible).CountIf(Columns(14), HK)
        End With

---

Thanks

Hi

I think the earlier code would work. Just replace the Jun and Jul values with the following

Code:

---

Jun = DateSerial(2012, 6, 1)
Jul = DateSerial(2012, 7, 1)

---

Hi

OK. Here is the code for Jun.

Code:

---

Sub Jun()
'*********************** 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 Jun As Date
    Dim Jul 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 ETS_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")
   
    Jun = DateSerial(2012, 6, 1)
    Jul = DateSerial(2012, 7, 1)
    HK = "Hong Kong"
    KT = "Kotka"
    HAM = "Hamburg"
    XMN = "Xiamen"
    SHA = "Shanghai"
   
    With wksRawData
        If .AutoFilterMode Then .AutoFilterMode = False 'remove autofilter
        LastRow = .Range("k" & .Rows.Count).End(xlUp).Row
        Set rngRawData = .Range("a5:w" & LastRow) 'set the range
        ETS_Col = "'" & .Name & "'!k6:k" & 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 June from Hong Kong to Kotka
    lngCount = Evaluate("sumproduct(--(month(" & ETS_Col & ")=month(""" & Jun & """+0)),--(" & Pol_Col & "=""" & HK & """),--(" & PoD_Col & "=""" & KT & """))")
   
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, Criteria1:=">=" & Jun, Operator:=xlAnd, _
                    Criteria2:="<" & Jul, 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 June"
    End If
  ' *************************************************************************
   
 ' **************** Hong Kong to Hamburg ***********************************
    'reset lngCount
    lngCount = 0
   
    'count whether any shipment exist in June from Hong Kong to Hamburg
    lngCount = Evaluate("sumproduct(--(month(" & ETS_Col & ")=month(""" & Jun & """+0)),--(" & Pol_Col & "=""" & HK & """),--(" & PoD_Col & "=""" & HAM & """))")
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, Criteria1:=">=" & Jun, Operator:=xlAnd, _
                    Criteria2:="<" & Jul, 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 June"
    End If
  ' *************************************************************************
 
  ' **************** Xiamen | Shanghai to Hamburg ***********************************
    'reset lngCount
    lngCount = 0
    'count whether any shipment exist in June from Xiamen and Shanghai to Hamburg
    lngCount = Evaluate("sumproduct(--(month(" & ETS_Col & ")=month(""" & Jun & """+0)),--(" & Pol_Col & "=""" & SHA & """)+(" & Pol_Col & "=""" & XMN & """),--(" & PoD_Col & "=""" & HAM & """))")
   
    'if exist
    If lngCount Then
        With rngRawData
            .AutoFilter field:=11, Criteria1:=">=" & Jun, Operator:=xlAnd, _
                    Criteria2:="<" & Jul, 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 June"
    End If
   
  ' *************************************************************************
   
    Set wksRawData = Nothing
    Set wksHKKot = Nothing
    Set wksHKHam = Nothing
    Set wksXMNSHAHam = Nothing
   
End Sub

---

Hi Admin, Thank so much to the time you are spending on this but still not working for me. On the spread sheet there are no rows in June from Hong Kong to Kotka to the msgbox should show but the lngCount = 1 when code is passed :(
Sorry. Xander

Hi

I got the msgbox saying 'No shipments from Hong Kong to Kotka in June'

Are you sure that you completely replaced the code with the above one ?

Yes I made sure to copy the whole code. Don't know how lngCount is finding 1 row as there are non against the Criteria. I am running Excell 2003. Would that make a difference? I cant see where we would differ on our workbooks?

I'm now convinced its because of cell format of my sheets. When I run the code line by line it filters June and there are no rows visible so the filter using Jun & Jul is not looking for 01/06/2012 / 01/07/2012 on my sheet because the date 06/06/2012 does exist. I have made sure the date is UK but still doesnt work :( I'm sure its a little setting making it not work as code is great.

p.s. Im having trouble getting my profile pic :)

I think i have it sussed. I just amended date to the previous and seems to be picking up the data.

Code:

---

Jan = #1/1/2012#
Feb = #1/2/2012#

---

My last problem is that my boss has decided he wants to filter by ETA not ETS so I need to change to column. I tried to do this by changing Ets_Col to Eta_Col and amending the code but its not liking it.

Code:

---

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(--(month(" & Eta_Col & ")=month(""" & Jan & """+0)),--(" & Pol_Col & "=""" & HK & """),--(" & PoD_Col & "=""" & KT & """))")

---

problem ocurres on the last line of above code :(
Thanks so much

Hi

It's working absolutely fine here. No clue why this isn't working at your end :(
I have tested this in both xl 2003 and 2007. BTW, I have changed the formula little bit so that it would take care of the year and month

lngCount = Evaluate("sumproduct(--(text(" & ETS_Col & ",""mmyy"")=text(""" & Jun & """+0,""mmyy"")),--(" & Pol_Col & "=""" & HK & """),--(" & PoD_Col & "=""" & KT & """))")

change the bold part in other two formulas as well.

For the next 10 days, I'll have limited access of net. So I might not able to answer your queries in time.

Hi

Just seen your post. replace Jan with cdate(jan), untested though.

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

---