Macro keeps crashing need to speed it up or rewrite it, excel vba 50,000 lines of data
Posted
by
Joel
on Super User
See other posts from Super User
or by Joel
Published on 2013-06-25T03:18:49Z
Indexed on
2013/06/25
4:23 UTC
Read the original article
Hit count: 476
Trying to speed up a macro that runs over 50,000 lines ! I have two ways of performing the same vba macro
Sub deleteCommonValue()
Dim aRow, bRow As Long
Dim colB_MoreFirst, colB_LessFirst, colB_Second, colC_MoreFirst, colC_LessFirst, colC_Second As Integer
Dim colD_First, colD_Second As Integer
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
aRow = 2
bRow = 3
colB_MoreFirst = Range("B" & aRow).Value + 0.05
colB_LessFirst = Range("B" & aRow).Value - 0.05
colB_Second = Range("B" & bRow).Value
colC_MoreFirst = Range("C" & aRow).Value + 0.05
colC_LessFirst = Range("C" & aRow).Value - 0.05
colC_Second = Range("C" & bRow).Value
colD_First = Range("D" & aRow).Value
colD_Second = Range("D" & bRow).Value
Do
If colB_Second <= colB_MoreFirst And colB_Second >= colB_LessFirst Then
If colC_Second <= colC_MoreFirst And colC_Second >= colC_LessFirst Then
If colD_Second = colD_First Or colD_Second > colD_First Then
Range(bRow & ":" & bRow).Delete
'bRow delete, assign new value to bRow
colB_Second = Range("B" & bRow).Value
colC_Second = Range("C" & bRow).Value
colD_Second = Range("D" & bRow).Value
'-----------------------------------------------------
Else
Range(aRow & ":" & aRow).Delete
bRow = aRow + 1
'aRow value deleted, assign new value to aRow and bRow
colB_MoreFirst = Range("B" & aRow).Value + 0.05
colB_LessFirst = Range("B" & aRow).Value - 0.05
colB_Second = Range("B" & bRow).Value
colC_MoreFirst = Range("C" & aRow).Value + 0.05
colC_LessFirst = Range("C" & aRow).Value - 0.05
colC_Second = Range("C" & bRow).Value
colD_First = Range("D" & aRow).Value
colD_Second = Range("D" & bRow).Value
'-----------------------------------------------------
End If
Else
bRow = bRow + 1
'Assign new value to bRow
colB_Second = Range("B" & bRow).Value
colC_Second = Range("C" & bRow).Value
colD_Second = Range("D" & bRow).Value
'-----------------------------------------------------
End If
Else
bRow = bRow + 1
'Assign new value to bRow
colB_Second = Range("B" & bRow).Value
colC_Second = Range("C" & bRow).Value
colD_Second = Range("D" & bRow).Value
'-----------------------------------------------------
End If
If IsEmpty(Range("D" & bRow).Value) = True Then
aRow = aRow + 1
bRow = aRow + 1
'finish compare aRow, assign new value to aRow and bRow
colB_MoreFirst = Range("B" & aRow).Value + 0.05
colB_LessFirst = Range("B" & aRow).Value - 0.05
colB_Second = Range("B" & bRow).Value
colC_MoreFirst = Range("C" & aRow).Value + 0.05
colC_LessFirst = Range("C" & aRow).Value - 0.05
colC_Second = Range("C" & bRow).Value
colD_First = Range("D" & aRow).Value
colD_Second = Range("D" & bRow).Value
'-----------------------------------------------------
End If
Loop Until IsEmpty(Range("D" & aRow).Value) = True
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = False
End Sub
or
Sub deleteCommonValue()
Dim aRow, bRow As Long
Application.ScreenUpdating = False
aRow = 2
bRow = 3
Do
If Range("B" & bRow).Value <= (Range("B" & aRow).Value + 0.05) _
And Range("B" & bRow).Value >= (Range("B" & aRow).Value - 0.05) Then
If Range("C" & bRow).Value <= (Range("C" & aRow).Value + 0.05) _
And Range("C" & bRow).Value >= (Range("C" & aRow).Value - 0.05) Then
If Range("D" & bRow).Value = (Range("D" & aRow).Value) _
Or Range("D" & bRow).Value > (Range("D" & aRow).Value) Then
Range(bRow & ":" & bRow).Delete
Else
Range(aRow & ":" & aRow).Delete
bRow = aRow + 1
Range("A" & aRow).Select
End If
Else
bRow = bRow + 1
Range("A" & bRow).Select
End If
Else
bRow = bRow + 1
Range("A" & bRow).Select
End If
If IsEmpty(Range("D" & bRow).Value) = True Then
aRow = aRow + 1
bRow = aRow + 1
End If
Loop Until IsEmpty(Range("D" & aRow).Value) = True
End Sub
I dont know if my best option will be to split the rows into multiple sheets?
© Super User or respective owner
