I apologise in advance for posting a long macro. I tested the faulty portion alone (which works fine) and I can't figure out why it won't work in the full implementation.
CONTEXT: my workbook contains 2 large databases (each has its own worksheet). I need to separate each of them into portions according to one specific variable, analyse each portion and summarise the results. This is the process:
- transfer data from "full" worksheets to "partial" worksheets (ws1_full to ws1_part and ws2_full to ws2_part)
- calculate stuff with data from "partial" worksheets (ws3_calc)
- copy paste to a summary (ws3_results)
- loop till all portions have been treated
However, the macro results in a
Run-time error '1004': application-defined or object-defined error.
I've isolated the faulty code (part 4c, near the end of the macro) and tested it in a new Excel file, which worked perfectly fine. The error happens either when copying the data or addressing the range, yet I believe both are implemented correctly. The rest of the macro works as intended.
I would have preferred uploading a shorter version of the macro, but as stated, that one worked. Here is the full macro:
Sub Macro1()
'
' data analysis Macro
'
Application.ScreenUpdating = False
Dim ws1_full, ws1_part, ws2_full, ws2_part, ws3_calc, ws3_results As Worksheet
Set ws1_full = Worksheets("1_full")
Set ws1_part = Worksheets("1_part")
Set ws2_full = Worksheets("2_full")
Set ws2_part = Worksheets("2_part")
Set ws3_calc = Worksheets("3_calc")
Set ws3_results = Worksheets("3_results")
iMax = 1 'update this accordingly, it uses =MAX(1_full!A:A) to find the max value of i
'delete the contents of the ws3_results table
lastRow = ws3_results.Range("A" & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
ws3_results.Range("A2:I" & lastRow).ClearContents
End If
For i = 1 To iMax
'1. delete contents of ws1_part
lastRow = ws1_part.Range("A" & Rows.Count).End(xlUp).Row
If lastRow > 2 Then
ws1_part.Range("A3:AW" & lastRow).ClearContents
End If
'2. delete contents of ws2_part
lastRow = ws2_part.Range("A" & Rows.Count).End(xlUp).Row
If lastRow > 2 Then
ws2_part.Range("A3:AN" & lastRow).ClearContents
End If
'3. copy data from ws1_full to ws1_part
lastRow = ws1_full.Range("A" & Rows.Count).End(xlUp).Row
For j = 5 To lastRow
lastRow2 = ws1_part.Range("A" & Rows.Count).End(xlUp).Row
If ws1_full.Cells(j, 1).Value = i Then
'copy and paste
ws1_full.Range("A" & j & ":AW" & j).Copy _
Destination:=ws1_part.Range("A" & lastRow2 + 1)
End If
Next
'4. copy data from ws2_full to ws2_part
'a. loop through each group in ws2_full
For k = 1 To 36 Step [5] 'these are the index columns for each group
lastRow = ws2_full.Cells(Rows.Count, k).End(xlUp).Row
'b. loop through each row
For j = 5 To lastRow
lastRow2 = ws2_part.Cells(Rows.Count, k).End(xlUp).Row
If ws2_full.Cells(j, k).Value = i Then
'c. copy paste
'THIS PART CAUSES THE RUN-TIME ERROR
ws2_full.Range(Cells(j, k), Cells(j, k + 4)).Copy _
Destination:=ws2_part.Cells(lastRow2 + 1, k)
'ws2_part.Cells(lastRow2 + 1, k).PasteSpecial Paste:=xlPasteValues This also doesn't work
End If
Next
Next
'5. copy data from ws3_calc to ws3_results
'a. update ws3_calc values
ws3_calc.Calculate
'b. copy paste to ws3_results
lastRow = ws3_results.Range("A" & Rows.Count).End(xlUp).Row
ws3_results.Cells(i + 1, 1) = i
ws3_calc.Range("A12:H12").Copy
ws3_results.Range("B" & lastRow + 1).PasteSpecial xlPasteValues
Next
ws3_results.Range("A1").Select
Application.ScreenUpdating = True
End Sub
I have tried all solutions to this VBA error that I found online and none have worked. Sorry for the long code.