Slow Macro

P

punkin0601

New Member
Joined
Aug 16, 2005
Messages
26
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

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
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)
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
Thank you so much for taking the time to review my code! Your new code made it run a lot faster.

Thank you again!
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
931
Joe4
Joe4
G
  • Solved
History of Dates to be traced in Excel (2010) in DD/MM/YYYY format
2
Replies
11
Views
360
MARK858
MARK858
N
  • Question
My code is suddenly really slow
Replies
1
Views
130
RobP
R
H
  • Solved
Range.Formula does not lead to cell "selected" or "active"
Replies
5
Views
98
heathball
H
Saher Naji
  • Question
VBA Code Issue on Mac Platform (working perfectly on Windows)
Replies
4
Views
282
Cristian Buse
C

Forum statistics

Threads
1,214,648
Messages
6,120,726
Members
448,987
Latest member
marion_davis

Share this page

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top