Why 1004 Run Time error at Red Text?

wavery

New Member
Joined
Jun 29, 2018
Messages
25
Sub CopyData_Machine_Performance()
Application.ScreenUpdating = False
Dim lastRow As Long
lastRow = Sheets("DATADump").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim ldateto As Long
Dim ldatefrom As Long
Dim ThisMonth As Long
Dim ThisYear As Long
ThisMonth = Month(Sheets("REPORTDATE").Range("C2"))
ThisYear = Year(Sheets("REPORTDATE").Range("C2"))
ldatefrom = DateSerial(ThisYear, ThisMonth, 1)
ldateto = DateSerial(ThisYear, ThisMonth + 1, 0)
With Sheets("SLOT MACHINE PERFORMANCE")
.Range("A4:t4") = Array("Asset Number", "Area", "Section", "Location", "Game Tpye", "Mfg", "Denom", "Theme", "Coin In", "CIPUPD", "Win", "T-Win", "Handle Pulls", "DOF", "WPUPD", "T-WPUPD", "Hold%", "T-Hold", "Avg Bet", "House Avg")
End With

With Sheets("DATADump").Range("A1").CurrentRegion

.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto

End With
Sheets("DATADump").Activate
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("O:O")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("P:P")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("Q:Q")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("R:R")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("E:E")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("S:S")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("D:D")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "G").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("T:T")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "H").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("G:G")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "I").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("H:H")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "J").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("J:J")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "K").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("K:K")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "L").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("L:L")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "M").End(xlUp).Offset(1, 0)
Intersect(Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible), Range("M:M")).Copy Sheets("SLOT MACHINE PERFORMANCE").Cells(Rows.Count, "N").End(xlUp).Offset(1, 0)
Sheets("SLOT MACHINE PERFORMANCE").Columns.AutoFit
If Sheets("DATADump").AutoFilterMode Then Sheets("DATADump").AutoFilterMode = False
Application.ScreenUpdating = True
Worksheets("DataDump").ShowAllData
Sheets("SLOT MACHINE PERFORMANCE").Select
Call WPUPD
End Sub
 

wavery

New Member
Joined
Jun 29, 2018
Messages
25
The Code was working fine until I added a new month of data. I added it the same as always??
 

Jonmo1

MrExcel MVP
Joined
Oct 12, 2006
Messages
44,061
Maybe the 'Current Region' isn't quite what you think it is..

Add this line in there, and what does the message box say?
Rich (BB code):
With Sheets("DataDump").Range("A1").CurrentRegion
    MsgBox .Address
    .AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto

End With
 

wavery

New Member
Joined
Jun 29, 2018
Messages
25
Msg Box Shows $A$1:$AA$101646
My Data A1:AA15841
My table is set A1:AA15841
 

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,082
If you don't know what a command word does, use F2 or put cursor in or next to the word in the VBE and press F1.

When you record a macro with dates, you get something like:
Code:
ActiveSheet.Range("$A$1:$A$13").AutoFilter Field:=1, Criteria1:= _
        ">=10/5/2018", Operator:=xlAnd, Criteria2:="<=1/3/2019"
e.g.
Code:
Msgbox Format(date, "mm/dd/yyyy")
If the range is wrong maybe you want UsedRange? e.g.
Code:
With Sheets("DataDump").UsedRange
    MsgBox .Address
    .AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto

End With
 

Jonmo1

MrExcel MVP
Joined
Oct 12, 2006
Messages
44,061
If the message box produced a range, then the range isn't the problem (it's OK that it's 'larger than' your actual data. Smaller may have been an issue).

So it must be the ctiteria that is the probem.
As Kenneth Suggests, try making your dates into Text.

Dim ldatefrom as String
ldatefrom = Format(DateSerial(yr,mnth,day),"mm/dd/yyyy")
 
Last edited:

wavery

New Member
Joined
Jun 29, 2018
Messages
25
I tried the date string and got no positive results. This code has been working for awhile now so I fond it strange that the date would all of the sudden not work. The only difference between this month an last month is more data. So for now I seems to work with the change below. I guess we will see what next month brings. Thank you al for your quick response and input, I have learned a lot by asking questions here.

With Sheets("DATADump").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto

I changed the Range
From:

  • With Sheets("DATADump").Range("A1").CurrentRegion


To:


  • With Sheets("DATADump").Range("A1")
 

Forum statistics

Threads
1,077,990
Messages
5,337,585
Members
399,156
Latest member
RaudMees

Some videos you may like

This Week's Hot Topics

Top