Hi guys,
I have the below macro that I am trying to speed up.
I have a table which pulls data from an Access DB, the data in the table changes upon selection of an item from a drop down list. The table needs to calculate upon each data 'refresh' in order to calculate some KPI's which I copy into another workbook.
This action is repeated to a total of 271 times. At the moment it is taking 2.5 hours to complete. I am hoping to decrease this time.
My concerns are around the drop down list/cycle item element, I don't think I have done this part too well as I have combined a few different sources to create it.
I have the below macro that I am trying to speed up.
I have a table which pulls data from an Access DB, the data in the table changes upon selection of an item from a drop down list. The table needs to calculate upon each data 'refresh' in order to calculate some KPI's which I copy into another workbook.
This action is repeated to a total of 271 times. At the moment it is taking 2.5 hours to complete. I am hoping to decrease this time.
My concerns are around the drop down list/cycle item element, I don't think I have done this part too well as I have combined a few different sources to create it.
VBA Code:
Sub SOFPChecksV2()
Dim Eccwbk As Workbook
Dim SOFPws As Worksheet, Trgws As Worksheet
Dim i As Long
Dim Res As Variant
Set Eccwbk = Workbooks("VTO3 Rec Model - Live.xlsm")
Set SOFPws = Eccwbk.Sheets("SOFP")
Set Trgws = Workbooks("Reconciliation 3 Progress Tracker - Live.xlsx").Sheets("2020")
Application.ScreenUpdating = False
For i = 1 To 271
Trgws.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(, 4).Value = Application.Transpose(SOFPws.Range("G1:G4").Value)
Trgws.Range("G" & Rows.Count).End(xlUp).Offset(1).Resize(, 4).Value = Application.Transpose(SOFPws.Range("H1:H4").Value)
Trgws.Range("L" & Rows.Count).End(xlUp).Offset(1).Resize(, 4).Value = Application.Transpose(SOFPws.Range("I1:I4").Value)
With SOFPws.Range("B4")
If .Value = "" Then
.Value = Eccwbk.Sheets("Locations").Range("A2").Value
Else
Res = Application.Match(.Value, Eccwbk.Sheets("Locations").Range("A2:A272"), 0)
If IsNumeric(Res) Then
.Value = Eccwbk.Sheets("Locations").Range("A2:A272").Cells(Res + 1, 1).Value
Else
.Value = ""
End If
End If
End With
Eccwbk.RefreshAll
Next i
End Sub