Is there a faster way to apply a formula down a lot of columns? + General macro efficiency improvements

RockandGrohl

Well-known Member
Joined
Aug 1, 2018
Messages
801
Office Version
  1. 365
Platform
  1. Windows
I have a portal that needs to be opened 600 times a week and I've made some small progress in optimising it, as it takes roughly 20 seconds to open.

This is currently down to about 14 seconds on our regular machines but I'd like to get this under 10 seconds if possible.

I've identified an area of code that takes approx 9 seconds to load, the first part takes 7 seconds, the below takes 2 seconds. These are pasted below:

Part 1

Code:
 If adopen <> True ThenApplication.DisplayAlerts = False
Set ad = Workbooks.Open("\\chw-dc03\company\Sales\Regional Press Selections\" & wbyr & "\Advert Data " & wbyr & ".csv", False, True)
Application.DisplayAlerts = True
Else
ad.Activate
End If


Set ads = Worksheets("Advert Data " & wbyr)


temp.Activate
Range("B1").Activate
Set cap = Worksheets("CAP")
ads.Activate


ads.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("Z3:Z" & Lastrow).FormulaR1C1 = "=SUMIFS('[" & a.Parent.Name & "]CAP'!C3,'[" & a.Parent.Name & "]CAP'!C1,RC1)"
Range("Z3:Z" & Lastrow).Copy
Range("Z3").PasteSpecial xlPasteValues


What this is doing is opening an external csv (this one must be kept external as it is a running-log of adverts). This CSV has 20,000 rows. It then adds a sumif (would a Vlookup be faster?? I don't know why my predecessor has a Sumif as CAP doesn't contain any duplicate values)

Yeah it then adds the sumif to have a temporary column, which has the product capacity against each of 20,000 rows.

Is there a faster way to apply a formula down 20,000 rows?

The advert sheet is closed down after the 2nd step, so is it beneficial to keep excel calculation on manual and remove the copy-paste special command?

Part 2

Ok, here's the grand-daddy. This huge piece of macro does only take 2 seconds to churn through which isn't the end of the world.

Code:
Range("A2").Activatewcs = Int(CDbl(DateValue(AdSelect.WkCom.Caption)))
x = 1
ExtCount = 0


Do Until Cells(ActiveCell.Row, "A").Value = ""
    If Cells(ActiveCell.Row, "N").Value = AdSelect.PapNam.Caption And Cells(ActiveCell.Row, "L").Value = wcs And Cells(ActiveCell.Row, "Q").Value = AdSelect.Dimen.Caption Then
    AdSelect.Controls("Frame" & x).Visible = True
        If Cells(ActiveCell.Row, "M").Value = "Just Go RT" And AdSelect.CompList.Value = "" Then
        AdSelect.CompList.Value = "Just Go"
        Call CompList_Change
        ads.Activate
        Else
            If Cells(ActiveCell.Row, "M").Value = "Omega RT" Then
            AdSelect.CompList.Value = "Omega"
            Call CompList_Change
            ads.Activate
            End If
        End If
    AdSelect.Controls("Tourno" & x).Caption = Cells(ActiveCell.Row, "A").Value
    AdSelect.Controls("Tourno" & x).Font.Size = 13
        If Left(AdSelect.Controls("Tourno" & x).Caption, 1) = 3 Then
        ExtCount = ExtCount + 1
        End If
        If Left(Cells(ActiveCell.Row, "O").Value, 4) = "(RS)" Then
            If ttype <> "rs" Then
            AdSelect.Rail.Value = True
            ttype = "rs"
            GoTo LoadAgain
            End If
        End If
        If Left(Cells(ActiveCell.Row, "O").Value, 11) = "Flying from" Then
            If ttype <> "ai" Then
            AdSelect.Air.Value = True
            ttype = "ai"
            GoTo LoadAgain
            End If
        End If
        If ttype = "rs" Then
        fprice = Cells(ActiveCell.Row, "H").Value
        Else
        fprice = Cells(ActiveCell.Row, "G").Value
        End If
    AdSelect.Controls("TDet" & x).Caption = Cells(ActiveCell.Row, "C").Value & "  •  " & Cells(ActiveCell.Row, "D").Value & "  •  " & Format(Cells(ActiveCell.Row, "E").Value, "dd/mm/yyyy") & "  •  " & Cells(ActiveCell.Row, "F").Value & " Days" & "  •  " & Format(Cells(ActiveCell.Row, "G").Value, "£#,##0.00") & "  •  " & Cells(ActiveCell.Row, "K").Value & "  •  " & Cells(ActiveCell.Row, "J").Value & "  •  " & Cells(ActiveCell.Row, "Z").Value & " Rem. Pax Cap."
    AdSelect.Controls("TDet" & x).Font.Size = 7
    AdSelect.Controls("Pickups" & x).Caption = Cells(ActiveCell.Row, "I").Value
    AdSelect.Controls("Pickups" & x).Font.Size = 7
    AdSelect.Controls("PULab" & x).Visible = True
    AdSelect.Controls("JGRTPrice" & x) = Format(Cells(ActiveCell.Row, "H").Value, "#,##0.00")
    AdSelect.Controls("JGRTPickups" & x) = Cells(ActiveCell.Row, "O").Value
        If AdSelect.Controls("JGRTPickups" & x).Text = "Making own way" Then
        AdSelect.SelfDrive.Value = True
        End If
    AdSelect.Controls("PriceLabel" & x).Visible = True
    AdSelect.Controls("Skip" & x).Visible = True
    AdSelect.Controls("Feat" & x).Visible = True
        If Cells(ActiveCell.Row, "R").Value <> "" Then
        AdSelect.TemplateList.Value = Cells(ActiveCell.Row, "R").Value
        Me.EnableEvents = False
        a.Activate
        Call TemplateList_Change
        ads.Activate
        End If
    Me.EnableEvents = False
        If Cells(ActiveCell.Row, "S").Value = "Featured" Then
        AdSelect.Controls("Feat" & x).Value = True
        Else
        AdSelect.Controls("List" & x).Value = True
        End If
    x = x + 1
    temp.Activate
    Cells(ActiveCell.Row, "B").Value = AdSelect.Controls("Tourno" & x - 1).Caption
    ActiveCell.Offset(1, 0).Activate
    ads.Activate
    End If
    If Cells(ActiveCell.Row, "L").Value = wcs - 7 And Cells(ActiveCell.Row, "N").Value = AdSelect.PapNam.Caption And Cells(ActiveCell.Row, "Q").Value = AdSelect.Dimen.Caption Then
    AdSelect.LWComp.Caption = Left(Cells(ActiveCell.Row, "M").Value, Len(Cells(ActiveCell.Row, "M").Value) - 3)
    AdSelect.LWTemp.Caption = Cells(ActiveCell.Row, "R").Value
        If AdSelect.CompList.Value = "" And AdSelect.LWComp.Caption = AdSelect.CompList.Value And Me.TChange = False And InStr(AdSelect.LWTemp.Caption, "Promo") = 0 Then
        AdSelect.TemplateList.Value = AdSelect.LWTemp.Caption
        End If
    End If
ActiveCell.Offset(1, 0).Activate
Loop


Without delving too deep in to that, or worry about what the values in R or N or whatever may mean, is there a more efficient way to do this? It's basically looking at Advert Data file and taking information to fill in 75 frames which contain product information.

The purpose of it is to click a newspaper, it opens the portal (20 seconds, now 14), the portal has 75 different products on it, you click a product and it updates the portal, if you commit the changes it permanently writes to Advert Data.


The longest part of the process is filling the portal with 75 ads which is what part 2 does, that huge code above. Is there anything there which looks unnecessary or is double-looping?

Thanks!
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Hi,

Have you tried switching off screenupdating and calculation? Something like the below

Code:
Sub test()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    'speed up processing

    'your code here

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    'reset

End Sub
 
Upvote 0
Hi,

Have you tried switching off screenupdating and calculation? Something like the below

Code:
Sub test()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    'speed up processing

    'your code here

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    'reset

End Sub


Hey,

Yeah sorry, I have :)

This is an excerpt from like, 2,000 lines of code. This particular part is what is taking the longest time.

Interestingly, if I put calculation on manual and execute the code, it take long (clocking in at 27 seconds)

As soon as I keep calculation on automatic, it only takes approx 14 seconds.
 
Upvote 0
Regarding part 1, which is the most important to work out, opening the CSV is a mere fraction of a second, it's definitely applying 20,000 instances of a Sumif.

Is sumif slower than a vlookup? It does need to be sumif for now, for example there can be three instances of a tour "123456" on the CAP page and it will show capacity for hotels.

If Sumif is really a lot slower, then I can give a summed-column to CAP and still do the vlookup. What do you guys think?
 
Upvote 0
I'm talking to myself here, haha.... Vlookup is indeed much faster than Sumif.

Sumif is required because the capacity sheet has multiple tours with multiple hotels, the total capacity must then be a sum of the hotel capacity for each tour.

However, I've gotten around this. When I make a local copy of Cap, I'm now performing the Sum calculation there, which only happens once. Now that I have a sum of hotel capacity per tour, I can perform a Vlookup, which has shaved about 2-3 seconds off the process. A good result!!!
 
Upvote 0
Sumif is slow and vlookup with exact match is slow. Can you sort your list on the lookup value ? If so then a vlookup with TRUE as the last parameter will be extremely fast.
 
Upvote 0
Sumif is slow and vlookup with exact match is slow. Can you sort your list on the lookup value ? If so then a vlookup with TRUE as the last parameter will be extremely fast.

I've heard Index/Match may yet be faster.


I wouldn't want to chance it with non-exact match, as tour codes are all unique but can be very similar, like EF20D5 and EF20D6

Choosing one wrong advert (out of well over 1,000) would result in a waste of like £70, per advert... Not something I want to chance tbh.
 
Upvote 0
Index match will only be faster than a non exact vlookup if you use a non exact match formula. Id do an IF test and use two non exact vlookups if you think it may be wrong eg:

=IF(VLOOKUP(lookupvalue,myTable,1,1)=lookupvalue,VLOOKUP(lookupvalue,myTable,10,1),"Not Found")

This is only to be used on a sorted list and will be quicker than eg:

=VLOOKUP(lookupvalue,myTable,10,0)

Both will produce the same result should the lookupvalue be found and the list of lookupvalues is sorted.
 
Upvote 0
I might be missing something but how do you guarantee that it will find the result I need, with a non-exact match?
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

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