Best way to copy data to a new sheet and reorganize it (VBA) - excel

Question

I'm writing a VBA program which copies and organizes data from one master sheet into numerous other sheets. One of the recipient sheets unifies all the data from the master sheet which holds the same id number into a single row. For this operation, I am looping through the master sheet for each id number, copying each row which holds the current id number into a new sheet purely used for calculations and organizing, and rearranging the data in this sheet into the new row. The resultant row is copied into the recipient sheet. This process of organizing data for every id number takes a long time to process, especially given the very large size of this sheet and the processing time of the other recipient sheets. I'm wondering if there is a better way to organize and copy data without using an intermediate calculation sheet.
The below code is the main sub, which calls another sub OrganizeAndCopyToPal, which organizes the data in the calculation sheet and copies the result into the recipient sheet.
Sub PalletAssemblyLog()
Dim allidNum As Range
Dim curridNum As Range
Dim rowCount As Long
Dim idNum
Dim I As Long
Dim j As Long
Dim machineLoc As String
Dim calc As Worksheet
Dim full As Worksheet
Dim pal As Worksheet
Set calc = Sheet3
Set full = Sheet4
Set pal = Sheet1
For I = 2 To rowCount
For j = 2 To rowCount
If full.Cells(j, 17).Value = idNum Then
If allidNum Is Nothing Then
Set allidNum = full.Cells(j, 17)
Else
Set allidNum = Union(allidNum, full.Cells(j, 17))
End If
End If
Next j
Set curridNum = allidNum.EntireRow
calc.Activate
calc.Cells.Clear
full.Activate
curridNum.Copy calc.Range("A1")
OrganizeAndCopyToPal curridNum
Next I
End Sub
The below sub organizes and copies the data for each id number. The final sub to copy the data isn't related to the matter of simplifying this task so I'm not including it.
Sub OrganizeAndCopyToPal(curridNum)
Dim calc As Worksheet
Dim pal As Worksheet
Set calc = Sheet3
Set pal = Sheet1
calc.Activate
Dim rowCount As Long
rowCount = calc.Cells(Rows.Count, "A").End(xlUp).Row
Dim palRow As Long
palRow = rowCount + 2
Dim partRow As Long
partRow = palRow + 2
Dim currPartCount As Range
Dim assembly As String
Dim id As String
Dim location As String
Dim machType As String
Dim machLoc As String
Dim currPart As String
Dim link As String
Dim tot As Long
tot = 0
With calc
.Cells(1, 1).Copy .Cells(palRow, 2)
assembly = .Cells(1, 1).Value
.Cells(1, 2).Copy .Cells(palRow, 5)
id = .Cells(1, 17).Value
asArray = SplitMultiDelims(id, "|-")
'MsgBox asArray(0) & " " & asArray(1) & " " & asArray(2)
machArray = Split(.Cells(1, 8), "-")
machType = machArray(0)
.Cells(palRow, 3) = machType
machLoc = .Cells(1, 8).Value
.Cells(palRow, 4) = machLoc
.Cells(1, 17).Copy .Cells(palRow, 10)
location = Cells(1, 9)
.Cells(palRow, 1) = location
For I = 1 To rowCount
partArray = Split(.Cells(I, 16).Value, ",")
For j = 0 To UBound(partArray)
partArray2 = Split(partArray(0), "-")
partPrefix = partArray2(0)
If j = 0 Then
currPart = partArray(j)
Else
currPart = partPrefix & "-" & CStr(partArray(j))
End If
tf = 1
For k = 0 To tot
If Cells(partRow + k, 1).Value = currPart Then
tf = 0
Exit For
End If
Next k
If tf = 1 Then
.Cells(partRow + tot, 1).Value = currPart
tot = tot + 1
End If
Next j
Next I
For I = 1 To tot
Cells(palRow, 10 + I).Value = Cells(partRow + I - 1, 1)
Next I
End With
CopyToPal curridNum, palRow
End Sub
Thank you for any tips or help that you can offer.

Answer 1

Before getting into more exotic solutions - the easiest thing you can do is set
Application.Calculation = xlCalculationManual
Before getting stuck into much code.
Then when you need to do an update before copying any data that may change due to formulae calcs, run
Application.Calculate
and eventually at the end reset it to
Application.Calculation = xlCalculationAutomatic
You can disable screen updates too, but the above will be the big (easy) one. After that we're into copying to arrays and working in them then pasting back.