Macro Error

wavery

New Member
Joined
Jun 29, 2018
Messages
25
I have been running this Macro for a while and all was good until my computer was upgraded to windows 10. My excel is now Excel 365 2016. The debugger highlights the row I put in red. Any help with this would be great.

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")
.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
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData
Sheets("SLOT MACHINE PERFORMANCE").Select
Call WPUPD
End Sub
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Your code works for me (Excel 2016/365, Windows10)

Q1 Do key cells contain values? - which values are in cells A1:B3 in sheet DataDump?
Q2 Does sheet "DataDump" exist? - perhaps you named it "Data Dump" in current workbook
Q3 Which error message are you seeing?

I forced the code to fail in the same place:
1. Rename DataDump [error message Subscript out of Range]
2. Leave column B empty [error message AutoFilter method of Range class failed]
3. Insert 2 empty rows in rows1:2 in DataDump [error message AutoFilter method of Range class failed]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,792
Messages
6,121,612
Members
449,038
Latest member
apwr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top