don't copy filtered data if no active cells

[xander1981]

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?



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]

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]

Hi

Try


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]

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


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

[Admin]

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]

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:


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]

Hi

try


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]

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]

Hi

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

[xander1981]

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


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

[xander1981]

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?


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

[xander1981]

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

[Admin]

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.

[xander1981]

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.



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.

[Admin]

Hi

Not sure how a -figure comes.

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


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

[xander1981]

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 :

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.

[xander1981]

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

[Admin]

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

[xander1981]

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 :)424

[xander1981]

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


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

[Admin]

Hi

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


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

[Admin]

Hi

OK. Here is the code for Jun.


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]

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]

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]

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]

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]

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


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.


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]

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]

Hi

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

[xander1981]

Let Joy be unconfined!! code works like a dream. Thanks for all your help :o Just in time for deadline tomorrow.

Final 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