don't copy filtered data if no active cells

**xander1981** · 10-24-2012, 01:58 PM

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.

**xander1981** · 10-24-2012, 03:47 PM

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

**Admin** · 10-24-2012, 06:04 PM

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

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

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)

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

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.

**xander1981** · 10-25-2012, 01:25 AM

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.

**Admin** · 10-25-2012, 09:49 AM

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

**xander1981** · 10-25-2012, 02:34 PM

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?

**Admin** · 10-25-2012, 02:57 PM

Hi

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

**xander1981** · 10-25-2012, 03:09 PM

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