Optimizing Slow VBA Code to Copy & Paste Formulas

itskdii

New Member
Joined
Jul 12, 2012
Messages
6
Hello - I am looking for any assistance someone can provide to help me optimize this slow VBA code. Processing 20,000 rows of data takes about 7 minutes.

Basically I have four columns of data generated from formulas - 1 sumifs, 1 countifs, and 2 vlookup. I calc the first row and then want to paste down to the last row of the sheet. I've tried to optimize my code as much as possible by implementing tips I found online. Any other suggestions would be appreciated. Please go easy on me - I'm a newbie.

Also - I'm using XP, Excel 2010
Thanks!

Sub retrieve_AccessData()


Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, intColIndex As Integer, DBFullName As String, TableName As String, TargetRange As Range


Dim sd As Date 'start date
Dim ed As Date 'end date



Set TargetRange = Sheets("BUS_Data").Cells(1, 1)


'input variables
sd = Sheets("Data_Selection").Range("c3").Value
ed = Sheets("Data_Selection").Range("c4").Value
DBFullName = "\\Rags004\AccessDB\Productivity\BUS_Productivity_Trakker.accdb"
TableName = "BUS_Raw"




'clear worksheet for data entry
Sheets("BUS_Data").Activate
[Cells].ClearContents
Range("A1").Select

'open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & DBFullName & ";"
Set rs = New ADODB.Recordset
mysql = "SELECT work_date, wc, user_id, user_name, oper, qty_conf, dshp FROM BUS_Raw WHERE work_date Between #" & sd & "# And #" & ed & "#"
With rs
.Open mysql, cn, adOpenStatic

For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

'pull clock hrs from kronos data
Sheets("BUS_Data").Select
Range("H1").Value = "clk_hrs"
Range("H2").FormulaR1C1 = _
"=SUM(SUMIFS(Kronos_Data!C7,Kronos_Data!C1,BUS_Data!RC1,Kronos_Data!C2,BUS_Data!RC3,Kronos_Data!C6,{""Regular"",""Overtime"",""Doubletime""}))"


'remove duplicate clock hrs for the same date and user id
Range("I1").Value = "tot_clk_hrs"
Range("I2").FormulaR1C1 = _
"=IF(COUNTIFS(R2C1:RC1,RC[-8],R2C3:RC3,RC[-6])=1,RC[-1],0)"


'pull in dept ref based on the wc
Range("J1").Value = "dept"
Range("J2").FormulaR1C1 = "=VLOOKUP(RC[-8],wc_xref!C[-9]:C[-6],4,FALSE)"


'pull in dept_home from kronos data based on user id
Range("K1").Value = "dept_home"
Range("K2").FormulaR1C1 = "=VLOOKUP(RC[-8],Kronos_Data!C[-9]:C[-7],3,FALSE)"

'copy formulas to the bottom of the sheet and replace with values
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
Range("H2:K2").Copy Destination:=Range("H3:K" & lastRow) 'copy / paste to last row **this is where it gets really slow**
Range("H2:K" & lastRow).Value = Range("H2:K" & lastRow).Value 'replace formulas with values
End With

Sheets("Data_Selection").Select
Range("A1").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True




End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
you seem part way there, try setting the calculation to manual, in the same place that you turn off alerts, and set it to automatic at the end

Code:
'Speeding Up VBA Code
    Application.ScreenUpdating = False 'Prevent screen flickering
    Application.Calculation = xlCalculationManual 'Preventing calculation

and at the end

Code:
'Remove All Speeding Up VBA Code
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
Upvote 0
you seem part way there, try setting the calculation to manual, in the same place that you turn off alerts, and set it to automatic at the end

Code:
'Speeding Up VBA Code
    Application.ScreenUpdating = False 'Prevent screen flickering
    Application.Calculation = xlCalculationManual 'Preventing calculation

and at the end

Code:
'Remove All Speeding Up VBA Code
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

Thanks for the reply! Actually after adding the code it looks like it prevented the copy / paste function from actually doing the calcs associated with the formulas. Basically in cells H3:K & lastrow - it copies the formulas from H2:K2 but since the doesnt do the calc it displays the value from H2:K2 as well.

Also - one point of clarification - the goal of this spreadsheet is to be able to calculate a years worth of data. What that amounts to is evaluate @ 240K lines of data from the Kronos_Data tab to calc and populate @ 180K lines of data on the BUS_Data tab. Is it ridiculous to think I could optimize code to do this in a few seconds?
 
Upvote 0
Try moving the calculation switch to automatic to after the end with
 
Upvote 0
Try moving the calculation switch to automatic to after the end with

After the "end with" has the same effect. I also tried doing it between the copy / paste and paste values. That made the copy / paste quick but when I flipped the calc back on that took about 7 min (same amount of time in my original code).
 
Upvote 0
my only other thoughts would be as follows, given that VLOOKUP is volatile and expensive on resources

Code:
Application.Calculation = xlCalculationManual 

'copy formulas to the bottom of the sheet and replace with values
Dim lastRow As Long
With ActiveSheet
    lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
    Range("H2:K2").Copy Destination:=Range("H3:K" & lastRow) 'copy / paste to last row **this is where it gets really slow**
    Range("H2:K" & lastRow).Value = Range("H2:K" & lastRow).Value 'replace formulas with values
End With

Application.Calculation = xlCalculationAutomatic
 
Upvote 0
Did that work, what is the timing like now ??
 
Upvote 0
No - it was a little faster but it didnt do the formula calc before copying and pasting as values.
 
Upvote 0
Can you post your current code
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,027
Members
448,543
Latest member
MartinLarkin

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