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

[RockandGrohl]

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

 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.

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!

 

[RockandGrohl]

Ah I see, that makes sense, thanks.