Good day,
I'm attempting to optimize a macro that was developed by Mr. Jerry Beaucaire to merge data. This takes anywhere form 2 minutes and 30 seconds to 4 minutes depending on the number of rows. My data is 67 columns and form 4,000 to 6,000 rows of information. Please see the code below. Any assistance would be greatly appreciated.
I'm attempting to optimize a macro that was developed by Mr. Jerry Beaucaire to merge data. This takes anywhere form 2 minutes and 30 seconds to 4 minutes depending on the number of rows. My data is 67 columns and form 4,000 to 6,000 rows of information. Please see the code below. Any assistance would be greatly appreciated.
VBA Code:
Sub MergeAnyData()
'Jerry Beaucaire (4/26/2010)
'For duplicated values in column A data is sorted and merged
Dim Lastrow As Long, Rw As Long
Dim LastCol As Long, Col As Long
Dim delRNG As Range
Application.ScreenUpdating = False
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Sort table by column A
Range("A1", Cells(Lastrow, LastCol)).Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
'start the delete rng
Set delRNG = Range("A" & Lastrow + 10)
'Merge data and mark rows for deletion at the end
On Error Resume Next
For Rw = Lastrow To 3 Step -1
If Range("A" & Rw) = Range("A" & Rw - 1) Then
For Col = 2 To LastCol
If Cells(Rw - 1, Col) = "" Then Cells(Rw - 1, Col) = Cells(Rw, Col)
Next Col
Set delRNG = Union(delRNG, Range("A" & Rw))
End If
Next Rw
'Delete and cleanup
delRNG.EntireRow.Delete xlShiftUp
Set delRNG = Nothing
Application.ScreenUpdating = True
End Sub
