I have a VBA code, which is used to iterate through the sorted data of Case IDs and transposes the row to the matching row if they are the same.
There are about 20k rows in the spreadsheet to look through. It often takes 20-40 minutes for the entire code to run. I'm not sure what I'm doing wrong.
Sub MyCombineRows()
Dim r As Long
Dim lngRow As Long
Dim lngCol As Long
Dim LastColumn As Long
Dim sht As Worksheet
Set sht = ActiveSheet
'Application.ScreenUpdating = False
' Set first row to start on (skipping first row of data)
r = 3
lngRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
LastColumn = findLastCol(r - 1)
Do
' Check to see if columns A is equal to row above it
If (Cells(r, "A") = Cells(r - 1, "A") And Cells(r, "A").Value <> "") Then
' Copy value from column to end of row above it
Range(Cells(r, 1), Cells(r, LastColumn)).Select
Selection.Cut
Cells(r - 1, LastColumn + 1).Select
ActiveSheet.Paste
'Delete Row
Rows(r).Delete
Do
If (Cells(r, "A") = Cells(r - 1, "A") And Cells(r, "A").Value <> "") Then
Dim newLastCol As Long
newLastCol = findLastCol(r - 1)
Range(Cells(r, 1), Cells(r, LastColumn)).Select
Selection.Cut
Cells(r - 1, newLastCol + 1).Select
ActiveSheet.Paste
Rows(r).Delete
Else
r = r + 1
If Cells(r, "A").Value = "" Then
Exit Do
End If
End If
Loop Until r = lngRow
Else
' Move on to next row
r = r + 1
End If
Loop Until r = lngRow
End Sub
Function findLastCol(rowNum As Long) As Long
Dim sht As Worksheet
Set sht = ActiveSheet
findLastCol = sht.Cells(rowNum, sht.Columns.Count).End(xlToLeft).Column
End Function