This Is So Slow!

W

woodpecker2

New Member
Joined
Aug 2, 2007
Messages
33
I've created a macro as shown below. The problem I have it takes well over an hour for it to run.

The rows that create the criteria for the LookUp are in excess of 40,000 and like wise, the area with the data that is being matched is also in excess of 40.000 rows.

I've turned off ScreenUpdating and AutoCalc, which has improved things slightly, but I need to really get it to run faster.

Can anyone help?

Code: 
Sub Macro10()

Dim LastRow As Long
LastRow = Range("M65536").End(xlUp).Row
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

    Range("H3:I3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(LOOKUP(2,1/((RC[-6]=R3C12:R" & LastRow & "C12)*(RC[-5]=R3C13:R" & LastRow & "C13)*(RC[-4]=R3C14:R" & LastRow & "C14)),R3C18:R" & LastRow & "C18)),""No Matching PLANOP Record"",LOOKUP(2,1/((RC[-6]=R3C12:R" & LastRow & "C12)*(RC[-5]=R3C13:R" & LastRow & "C13)*(RC[-4]=R3C14:R" & LastRow & "C14)),R3C18:R" & LastRow & "C18))"
    Range("H3:I3").Select
    Range("I3").Activate
    ActiveCell.FormulaR1C1 = "Thursday"
    LastRow = Range("B65536").End(xlUp).Row
    Range("H3:I3").Select
    Selection.Copy
    Range("H3:H" & LastRow).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    ActiveWindow.LargeScroll ToRight:=-1
    Range("B3").Select
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
You'll speed things up a ton if you eliminate the select statements, which are generally useless, as well as screen navigation.

How's this (not tested):

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Macro10()
    <SPAN style="color:#00007F">Dim</SPAN> LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    <SPAN style="color:#00007F">With</SPAN> Application
        .ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
        .Calculation = xlCalculationManual
    
            LastRow = Range("M65536").End(xlUp).Row
        
            Range("H3:I3").FormulaR1C1 = _
                "=IF(ISERROR(LOOKUP(2,1/((RC[-6]=R3C12:R" & LastRow & "C12)*(RC[-5]=R3C13:R" & LastRow & "C13)*(RC[-4]=R3C14:R" & LastRow & "C14)),R3C18:R" & LastRow & "C18)),""No Matching PLANOP Record"",LOOKUP(2,1/((RC[-6]=R3C12:R" & LastRow & "C12)*(RC[-5]=R3C13:R" & LastRow & "C13)*(RC[-4]=R3C14:R" & LastRow & "C14)),R3C18:R" & LastRow & "C18))"
            
            Range("I3") = "Thursday"
            
            LastRow = Range("B65536").End(xlUp).Row
            
            Range("H3:I3").Copy
            Range("H3:H" & LastRow).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            <SPAN style="color:#00007F">False</SPAN>, Transpose:=<SPAN style="color:#00007F">False</SPAN>
            
        .CutCopyMode = <SPAN style="color:#00007F">False</SPAN>
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

Smitty
 
Upvote 0
what exactly does that massive formula do

thats definitely taken a huge amount of the cake right there

maybe theres an easier way to code it or do the same thing
 
Upvote 0
Pennysaver

Thought your solution had worked but realised that the copy/paste part was before the calcualtion being switched on and was as values.

I did modify it, and it speeded up the process by a couple of minutes only.

Hope someone can assist further as I really need to get this working a lot faster?

QuietRiot

The formula looks up values in columns B,C and D, if it finds an exact match in columns L,M and N it put's the value from the corresponding cell (column R) as the value it was trying to find.

If anyone can come up with an alternative method for doing this, it would be appreciated.
 
Upvote 0
How about cutting the formula in half.

i.e
Code: 
Sub Macro10()
    Dim LastRow As Long
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    
            LastRow = Range("M65536").End(xlUp).Row
        
            Range("H3:I3").FormulaR1C1 = _
                "=IF(LOOKUP(2,1/((RC[-6]=R3C12:R" & LastRow & "C12)*(RC[-5]=R3C13:R" & LastRow & "C13)*(RC[-4]=R3C14:R" & LastRow & "C14)),R3C18:R" & LastRow & "C18)

            If Not IsError("H3") Then [H3].Value = "No Matching PLANOP Record"
            If Not IsError("I3") Then [I3].Value = "No Matching PLANOP Record"
            
            Range("I3") = "Thursday"
            
            LastRow = Range("B65536").End(xlUp).Row
            
            Range("H3:I3").Copy
            Range("H3:H" & LastRow).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
            
        .CutCopyMode = False
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
 
Upvote 0
This should be quite speedy, Using a VBA method to replace the formula use:
Code: 
Sub Macro10()
Dim LastRow As Long
Dim CountCel As Long
Dim Val1, Val2, Val3

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Val1 = Range("B3")
    Val2 = Range("C3")
    Val3 = Range("D3")
    Range("H3") = "No Matching PLANOP Record"
    For CountCel = 3 To Range("M65536").End(xlUp).Row
        If Val1 = Range("L:L")(CountCel) And _
                Val2 = Range("M:M")(CountCel) And _
                Val3 = Range("N:N")(CountCel) Then
            Range("H3") = Range("R:R")(CountCel)
        End If
    Next CountCel
    LastRow = Range("B65536").End(xlUp).Row - 2
    Range("H3").Resize(LastRow) = Range("H3")
    Range("I3").Resize(LastRow) = "Thursday"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

HTH,
~Gold Fish
 
Upvote 0
Have tried the code provided by Goldfish but the code does not appear to work correctly.

I amended the first record so that it would not be able to find a match in the data and it showed "No Matching PLANOP Record", but it also showed the same even if there was a matching record.

I then amended my first record so that the data was correct and this was recorded correctly, however all that seemed to happen was that record was then shown against all the entries.

It's as though its not picking up the corresponding record from column R

I've attached a table which shows my original formula and might give a better understanding.
PLANOP AlignTool New3.xls
BCDEFGHIJKLMNOPQR
2ProductFromToSpareAmountSpareSlotInward Processing SlotProductFromToSpareAmountSpareSlot
3WashersABAxm0.67No Matching PLANOP RecordThursdayWashersABBm0.43Wednesday
4WashersABBxm0.18ThursdayThursdayWashersABBxm0.12Thursday
5WashersABCm1.75FridayThursdayWashersABCm1.11Friday
6WashersABDm0.34SaturdayThursdayWashersABDm0.22Saturday
7WashersABEm1.19No Matching PLANOP RecordThursdayWashersABExm0.75Sunday
8WashersABFm0.74MondayThursdayWashersABFm0.47Monday
9WashersABGm0.42TuesdayThursdayWashersABGm0.27Tuesday
10WashersABHm0.45WednesdayThursdayWashersABHm0.29Wednesday
11WashersABIm0.17ThursdayThursdayWashersABIm0.11Thursday
Sheet3
 
Upvote 0
Ah! You are right, I didn't understand the code at first, the example you posted helps tremendiously. Try this:
Code: 
Sub Macro10()
Dim LastRow As Long
Dim Count_a As Long, Count_b As Long
Dim Val1, Val2, Val3

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    LastRow = Range("M65536").End(xlUp).Row
    Range("H3").Resize(LastRow - 2) = "No Matching PLANOP Record"
    For Count_b = 3 To LastRow
        Val1 = Range("B:B")(Count_b)
        Val2 = Range("C:C")(Count_b)
        Val3 = Range("D:D")(Count_b)
        For Count_a = 3 To LastRow
            If Val1 = Range("L:L")(Count_a) And _
                Val2 = Range("M:M")(Count_a) And _
                Val3 = Range("N:N")(Count_a) Then
               Range("H:H")(Count_b) = Range("R:R")(Count_a)
            End If
        Next Count_a
    Next Count_b
    Range("I3").Resize(Range("B65536").End(xlUp).Row - 2) = "Thursday"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

~Gold Fish
 
Upvote 0
Perhaps :-

Code: 
Dim LastRow#, rng1 As Range, rng2 As Range, cell As Range, found As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LastRow = Range("M65536").End(xlUp).Row
Set rng1 = Range("S3:S" & LastRow)
Set rng2 = Range("T3:T" & LastRow)
rng1.FormulaR1C1 = "=RC[-16]&RC[-15]&RC[-14]"
rng2.FormulaR1C1 = "=RC[-7]&RC[-6]&RC[-5]"
Range("H3:H" & LastRow) = "No Matching PLANOP Record"
For Each cell In rng1
    Set found = rng2.Find(What:=cell)
    If Not found Is Nothing Then cell(1, -10) = found(1, -1).Value
Next
Range("I3:I" & LastRow) = "Thursday"
[S:T].Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Or maybe :-

Code: 
Dim LastRow#, rng1 As Range, rng2 As Range, cell As Range, found As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LastRow = Range("M65536").End(xlUp).Row
[R:S].Insert
Set rng1 = Range("R3:R" & LastRow)
Set rng2 = Range("S3:S" & LastRow)
rng1.FormulaR1C1 = "=RC[-15]&RC[-14]&RC[-13]"
rng2.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-4]"
With Range("H3:H" & LastRow)
    .FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[10],R3C[11]:R" & LastRow & _
        "C[12],2,0)),""No Matching PLANOP Record"",VLOOKUP(RC[10],R3C[11]:R" & LastRow & "C[12],2,0))"
    .Value = .Value
End With
[R:S].Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
Upvote 0
This is probably a bit quicker than the second bit of code in my last post :-

Code: 
Dim LastRow#, rng1 As Range, rng2 As Range, cell As Range, found As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LastRow = Range("M65536").End(xlUp).Row
Set rng1 = Range("S3:S" & LastRow)
Set rng2 = Range("T3:T" & LastRow)
rng1.FormulaR1C1 = "=RC[-16]&RC[-15]&RC[-14]"
rng2.FormulaR1C1 = "=RC[-7]&RC[-6]&RC[-5]"
[U:U] = [R:R].Value
With Range("H3:H" & LastRow)
    .FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[11],R3C[12]:R" & LastRow & _
        "C[13],2,0)),""No Matching PLANOP Record"",VLOOKUP(RC[11],R3C[12]:R" & LastRow & "C[13],2,0))"
    .Value = .Value
End With
[S:U].ClearContents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


Note : I doubt that goldfish's code is faster than the OP's original code.
It's probably a lot slower since with 40,000 rows, it needs to loop 1,600,000,000 times.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Calculate P-Value. Range v Array
Replies
0
Views
238
Bernieg
B
P
  • Solved
Seeking a better way to CountIF with dynamic range without dragging cells down columns.
2
Replies
11
Views
1K
Peter_SSs
Peter_SSs
H
  • Question
error 1004 Paste method of worksheet failed
Replies
2
Views
1K
Alex Blakenburg
A
jalrs
  • Solved
FormulaR1C1 Not Working?
2
Replies
14
Views
3K
jalrs
jalrs
VinceF
  • Question
Circular Reference Error
Replies
8
Views
384
VinceF
VinceF

Forum statistics

Threads
1,214,784
Messages
6,121,536
Members
449,037
Latest member
tmmotairi

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