nirvehex
12-30-2014, 10:47 AM
Hello all. Someone was helping me write some VBA code to insert blank rows below based on two conditions. The following is a working code:
Sub InsertBlankRow()
Dim LRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For LRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Cells(LRow, "B") <> Cells(LRow - 1, "B") And Cells(LRow - 1, "AB") = "T" Then
If Cells(LRow - 2, "B") = Cells(LRow - 1, "B") Then
'Then Account has more then one row so T as the only option is not possible
Else
'T is the only option so insert the row
Rows(LRow).EntireRow.Insert
End If
End If
Next LRow
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
It does exactly what I need it do, however we were trying to make it faster. So the person made this code, but said he couldn't get it quite right.
Sub Macro1()
Dim arr() As Variant
Dim LRow As Long
For LRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Cells(LRow, "B") <> Cells(LRow - 1, "B") And Cells(LRow - 1, "AB") = "T" Then
If Cells(LRow - 2, "B") = Cells(LRow - 1, "B") Then
'Then Account has more then one row so T as the only option is not possible
Else
'T is the only option so add to array
b = b + 1
ReDim Preserve arr(1 To b)
arr(b) = LRow
End If
End If
Next LRow
Rows(arr(b)).Insert
End Sub
The idea here is to insert all rows at once instead of one at a time to speed it up. Any idea how to fix the second set of code here?
Thank you!
Sub InsertBlankRow()
Dim LRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For LRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Cells(LRow, "B") <> Cells(LRow - 1, "B") And Cells(LRow - 1, "AB") = "T" Then
If Cells(LRow - 2, "B") = Cells(LRow - 1, "B") Then
'Then Account has more then one row so T as the only option is not possible
Else
'T is the only option so insert the row
Rows(LRow).EntireRow.Insert
End If
End If
Next LRow
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
It does exactly what I need it do, however we were trying to make it faster. So the person made this code, but said he couldn't get it quite right.
Sub Macro1()
Dim arr() As Variant
Dim LRow As Long
For LRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Cells(LRow, "B") <> Cells(LRow - 1, "B") And Cells(LRow - 1, "AB") = "T" Then
If Cells(LRow - 2, "B") = Cells(LRow - 1, "B") Then
'Then Account has more then one row so T as the only option is not possible
Else
'T is the only option so add to array
b = b + 1
ReDim Preserve arr(1 To b)
arr(b) = LRow
End If
End If
Next LRow
Rows(arr(b)).Insert
End Sub
The idea here is to insert all rows at once instead of one at a time to speed it up. Any idea how to fix the second set of code here?
Thank you!