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

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
idNum = full.Cells(I, 17).Value
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 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.

Some comments that you hopefully find useful:

1. (Best Practice)Declare "Option Explicit" at the top of every module. This option requires that every variable used in the module is explicitly declared. Doing so avoids numerous errors, not the least of which are new-variables-declared-by-typo which can be hard to spot. Declaring it at the top of the provided code resulted in the need to add 9 declarations.
2. (Best Practice)Explicitly declare types for your variables and parameters. Dim idNum implicitly declares idNum as a Variant. It is probably a Long - but now, to the reader has to look through the code to know for sure. Sub OrganizeAndCopyToPal(curridNum) => parameter curridNum is, by default, declared as a Variant - but it is a Range. Sub OrganizeAndCopyToPal(curridNum As Range) removes all ambiguity.

Naming things.

1. You can change the code name of worksheets (e.g., Sheet3). So there is no need for Dim calc As Worksheet, Set cal = Sheet3. Simply rename Sheet3 to calc in the Properties Window. Now you do not need to declare and assign calc in your code - you can just use it directly as a Worksheet object. Same comment for full and pal.
2. Use meaningful names. Single character names are non-descriptive and (IMO) make code harder to read. Even loop and array index variables are easier to interpret if given names like 'idxRow', 'rowNum', etc. Descriptive names will not slow down your code or take up too much memory. What a descriptive name will do is allow you to avoid lots of re-interpretation time when you want to update this code after a long absence.

Don't Repeat Yourself (DRY) and magic numbers:

1. As an example, PalletAssemblyLog repeats the expression full.Cells(j, 17) 3 times in 5 lines. This expression is both repeated and contains a 'magic number' - 17. 17 must be an important column in the full worksheet...give it a name! (full could use a more descriptive name as well). Private Const idNumberColumn As Long = 17 will not slow down the code, but it is much more readable...and - most importantly, as soon as you need to insert a new column prior to column 17, you only have to change the column number in one location.
2. Sub OrganizeAndCopyToPal(curridNum) uses lots of magic numbers that need a name: 2,5,4,8,10,16. Give them all names and assign them as constant values in one location. You'll thank yourself in the future when the calc worksheet is eventually re-organized.

Single Responsibility Principle (SRP): Each procedure should have a single purpose (or, have a single reason to change)

1. The OrganizeAndCopyToPal procedure by its name, betrays that it does two things: Organizes and Copies. In fact, the passed-in argument curridNum is not used until the end of OrganizeAndCopyToPal when it is a parameter in the expression CopyToPal curridNum, palRow. There is no need to pass curridNum as a parameter because the subroutine does not need to know the curridNum in order to determine the palRow. Calculating palRow is a single responsibility - consider making OrganizeAndCopyToPal a function like 'Function DetermineRowTarget() As Long'.
2. Don't hesitate to break out blocks of code from procedures that can be explained/documented using a function name. Within PalletAssemblyLog, there is a nested loop that gathers all ranges related to the same id number. Rather than sifting through the loop logic to discover what does, it could be better self-documenting by making it a Function that returns palRow. In this case it receives bonus points for a reduction in loop nesting.

Speed

1. Within the main loop, you are activating worksheets multiple times. It is not clear to me that you need to make the various sheets 'Active' for the modification code that you have. Simply reducing/eliminating anything that causes a redraw within a loop will speed things up.
2. It looks as though you are processing the full set of idNum rows every time you increment the idNum. If true, this means you are repeating the operations many, many more times than needed. Change the logic to ensure you only process each idNum once. This should greatly speed up your process. One way to do this is to cache the Range result for each idNum. So, the next time you encounter the idNum, you can skip it. Also, the inner loop should start at the row + 1 of the 'new' idNum. This avoid iterating through previously evaluated rows. The example below uses a Dictionary to cache the Range results. Once all the Ranges for each idNum are determined, it runs though each idNum to Organize as before.
3. During the operations, temporarily turn off screen updating and calculations(if the operation does not depend on the calculations)

Below is the code with some of the edits described above.

    Option Explicit

Private Const idNumberColumn As Long = 17

Sub PalletAssemblyLog()

Dim allidNum As Range
Dim curridNum As Range
Dim rowCount As Long
Dim idNum As Long
Dim I As Long
Dim j As Long
Dim machineLoc As String

'Dictionary requires a reference to the 'Microsoft Scripting Runtime'.  From Tools menu: Tools -> References
Dim processedIdNumbers As Dictionary
Set processedIdNumbers = New Dictionary

Dim rowIdx As Long
For rowIdx = 2 To rowCount
idNum = full.Cells(rowIdx, idNumberColumn).Value

If Not processedIdNumbers.Exists(idNum) Then
Set curridNum = GetAggregatedRangeForIdNumber(idNum, rowIdx + 1, rowCount)

End If
Next rowIdx

Dim vKey As Variant
For Each vKey In processedIdNumbers.Keys

Dim idRange As Range
Set idRange = processedIdNumbers(vKey)
calc.Activate
calc.Cells.Clear

full.Activate
idRange.Copy calc.Range("A1")

Dim palRow As Long
palRow = DetermineRowTarget()

CopyToPal idRange, palRow
Next
End Sub

Private Function GetAggregatedRangeForIdNumber(idNumber As Long, startRow As Long, rowCount As Long) As Range
Dim allidNum As Range
Dim nextRange As Range

Dim rowIdx As Long
For rowIdx = startRow To rowCount
Set nextRange = full.Cells(rowIdx, idNumberColumn)
If nextRange.Value = idNumber Then
If allidNum Is Nothing Then
Set allidNum = nextRange
Else
Set allidNum = Union(allidNum, nextRange)
End If
End If
Next rowIdx
Set GetAggregatedRangeForIdNumber = allidNum.EntireRow
End Function

'formerly OrganizeAndCopyToPal
'Contains some magic numbers to assign names
Function DetermineRowTarget() As Long

calc.Activate

Dim rowCount As Long
rowCount = calc.Cells(Rows.Count, "A").End(xlUp).Row

Dim palRow As Long
'*******************************
'              code truncated for brevity
'*******************************

DetermineRowTarget = palRow

End Function