# Slow Macro

#### punkin0601

##### New Member
I have a macro that is running incredibly slow. I have the screenupdating shut off for the macro also. I have included a portion of my code in case I need to make adjustements to it. I have a drop down list where you select the month. Based on the selection the macro does the following. Any help would be appreciated. Right now, it is so slow that it better to not use the macro.

'October

Case Is = 1

Dim Rng As Range, c As Range
Set Rng = ActiveSheet.Range("A15:A" & Range("A65536").End(xlUp).Row)

For Each c In Rng
Cells(c.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC5,3,0)"

Next c

'November

Case Is = 2

Dim cell As Range
Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC6,4,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC6,4,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC6,4,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC6,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

### Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

#### Von Pookie

##### MrExcel MVP
Can you post all of the code?

#### Norie

##### Well-known Member
Why are you looping?

Why not just put the formula in 1 cell and copy it down?

Perhaps something like this untested code.
Code:
``````Dim Rng As Range
Set Rng = ActiveSheet.Range("A15:A" & Range("A65536").End(xlUp).Row)

Cells(15, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC5,3,0)"

Cells(15, "b").Copy rng.Offset(0,1)``````

#### punkin0601

##### New Member
Here is all my code. It is very long. Thank you for taking a look at it!

Sub Balance()

Application.ScreenUpdating = False

' Clear_Data Macro

Range("A14").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("A14").Select

'Copy Account numbers over to Balance Sheet

Sheets("VB Input").Select
Range("C3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Balances").Select
Range("A14").Select
ActiveSheet.Paste

Application.Run "'MP TB.xls'!Balance_Amounts"

Columns("B:B").Select
Selection.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
Range("b15").Select

Range("B14").Select
ActiveCell.FormulaR1C1 = "Balance"
Range("B14").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="-"
Range("B15").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
Selection.AutoFilter

Application.ScreenUpdating = True

End Sub

Sub Balance_Amounts()

Application.ScreenUpdating = False

Select Case Sheets("Balances").Range("M1")

'October

Case Is = 1

Dim Rng As Range, c As Range
Set Rng = ActiveSheet.Range("A15:A" & Range("A65536").End(xlUp).Row)

For Each c In Rng
Cells(c.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC5,3,0)"

Next c

'November

Case Is = 2

Dim cell As Range
Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC6,4,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC6,4,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC6,4,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC6,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'December

Case Is = 3

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC7,5,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC7,5,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC7,5,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC7,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'January

Case Is = 4

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC8,6,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC8,6,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC8,6,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC8,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'February

Case Is = 5

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC9,7,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC9,7,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC9,7,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC9,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'March

Case Is = 6

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC10,8,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC10,8,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC10,8,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC10,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'April

Case Is = 7

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC11,9,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC11,9,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC11,9,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC11,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'May

Case Is = 8

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC12,10,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC12,10,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC12,10,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC12,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'June

Case Is = 9

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC13,11,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC13,11,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC13,11,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC13,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'July

Case Is = 10

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC14,12,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC14,12,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC14,12,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC14,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'August

Case Is = 11

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC15,13,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC15,13,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC15,13,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC15,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

'September

Case Is = 12

Cells.EntireRow.Hidden = False
Range("A15:A" & Range("A65536").End(xlUp).Row).Select

For Each cell In Selection

If Left(cell.Text, 1) = "1" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC16,14,0)"
If Left(cell.Text, 1) = "2" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC16,14,0)"
If Left(cell.Text, 1) = "3" Then Cells(cell.Row, "b") = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC16,14,0)"
If Left(cell.Text, 1) > "3" Then Cells(cell.Row, "b") = "=SUM(INDEX('VB Input'!R1C5:RC16,MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

Next cell

End Select

Set Rng = Nothing

End Sub

#### punkin0601

##### New Member
I am having it loop because depending on the text in column A, I need different results in colum B. I am new at this macro stuff. Looping was the only way I could think to get the macro to do what I needed.

#### Von Pookie

##### MrExcel MVP
Ok. None of this is tested, but I cleaned it up a little--maybe it'll run a bit faster for you:

The first part of the code you posted:
Code:
``````Sub Balance()
Dim LastCell As Range

Application.ScreenUpdating = False

' Clear_Data
With Sheets("Balances")
Set LastCell = .Range("A14").End(xlDown).End(xlToRight)
.Range("A14", LastCell).ClearContents
End With

'Copy Account numbers over to Balance Sheet
With Sheets("VB Input")
.Range("C3", .Range("C3").End(xlDown)).Copy _
Destination:=Sheets("Balances").Range("A14")
End With

Application.Run "'MP TB.xls'!Balance_Amounts"

With Sheets("Balances")
.Columns("B:B").NumberFormat = _
"_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
With .Range("B14")
.Value = "Balance"
.AutoFilter
.AutoFilter Field:=2, Criteria1:="-"
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("B14").AutoFilter

Application.ScreenUpdating = True

End Sub``````

Then the main one:

Code:
``````Sub Balance_Amounts()
Dim Rng As Range, cell As Range, myMonth As Integer
Dim frmRng As String, frmCol As String, myFrm As String

Application.ScreenUpdating = False

With Sheets("Balances")
myMonth = .Range("M1").Value

If myMonth = 1 Then
Set Rng = .Range("B15:B" & .Range("A65536").End(xlUp).Row)
Rng.FormulaR1C1 = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC5,3,0)"
Else
.Cells.EntireRow.Hidden = False
Set Rng = .Range("A15:A" & .Range("A65536").End(xlUp).Row)

Select Case myMonth
Case Is = 2 'November
frmRng = 6
frmCol = 4
Case Is = 3 'December
frmRng = 7
frmCol = 5
Case Is = 4 'January
frmRng = 8
frmCol = 6
Case Is = 5 'February
frmRng = 9
frmCol = 7
Case Is = 6 'March
frmRng = 10
frmCol = 8
Case Is = 7 'April
frmRng = 11
frmCol = 9
Case Is = 8 'May
frmRng = 12
frmCol = 10
Case Is = 9 'June
frmRng = 13
frmCol = 11
Case Is = 10 'July
frmRng = 14
frmCol = 12
Case Is = 11 'August
frmRng = 15
frmCol = 13
Case Is = 12 'September
frmRng = 16
frmCol = 14
End Select

For Each cell In Rng
Select Case Left(cell.Value, 1)
Case Is = 1, 2, 3
myFrm = "=VLOOKUP(RC[-1],'VB Input'!R1C3:RC" _
& frmRng & "," & frmCol & ",0)"

cell.Offset(, 1).FormulaR1C1 = myFrm
Case Is > 3
myFrm = "=SUM(INDEX('VB Input'!R1C5:RC" _
& frmRng & ",MATCH(RC[-1],'VB Input'!R1C3:RC3,0),0))"

cell.Offset(, 1).FormulaR1C1 = myFrm
End Select
Next cell
End If
End With

Application.ScreenUpdating = True

End Sub``````

#### punkin0601

##### New Member
Thank you so much for taking the time to review my code! Your new code made it run a lot faster.

Thank you again!

Replies
4
Views
403
Replies
1
Views
394
Replies
9
Views
236
Replies
29
Views
559
Replies
17
Views
567

1,195,936
Messages
6,012,394
Members
441,695
Latest member
MickRobertson

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back