don't copy filtered data if no active cells

**Admin** · 10-30-2012, 10:51 PM

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)

**Admin** · 10-31-2012, 08:23 AM

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

**xander1981** · 10-31-2012, 06:52 PM

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

**Admin** · 10-31-2012, 07:56 PM

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 ?

**xander1981** · 10-31-2012, 08:30 PM

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?

**xander1981** · 10-31-2012, 08:58 PM

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

**xander1981** · 10-31-2012, 10:00 PM

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

**Admin** · 10-31-2012, 10:07 PM

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.

**Admin** · 10-31-2012, 10:11 PM

Hi

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

**xander1981** · 11-01-2012, 06:47 PM

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