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

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
 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 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

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)
 
 processedIdNumbers.Add idNum, curridNum
 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