'Copy Loop from 1 Sheet to Multiple Sheet
I am able to achieve my results, but wanted to optimize my code further. Currently, for 15 projects, it takes 25 seconds. But I am expecting projects to be increased to 2000 which would take 30 minutes to execute this code. How can I further optimize this code.
Project_and_capex_costs = This sheet holds project details in each row DC_Price_calc = This is where data is copied from above sheet and also Goal seek calculation is performed DC_Price_table = This is where project data is copied from 1st sheet and also Goal seek is copied from DC_price_calc sheet Revenue_forecast_table = This sheet data is copied from DC_Price_calc Interest_forecast_table = This sheet data is copied from DC_Price_calc
The entire process above is repeated for each Project line by line
Sub Process_Price_Revenue()
Dim i As Long
Dim n As Long: n = 5
Dim wsData As Worksheet, wsCalcAndOutput As Worksheet, wsTemp As Worksheet 'specify each type
Dim LR As Long
With Worksheets("Project_and_capex_costs")
LR = .Range("E" & Rows.Count).End(xlUp).Row
For i = 10 To LR
If .Cells(i, 5) <> "" Then
Range(.Cells(i, "E"), Cells(i, "E")).Copy 'Project ID
Worksheets("DC_price_calc").Cells(8, "B").PasteSpecial xlValues
Range(.Cells(i, "F"), Cells(i, "F")).Copy 'Project Name
Worksheets("DC_price_calc").Cells(9, "B").PasteSpecial xlValues
Range(.Cells(i, "BL"), Cells(i, "BL")).Copy 'Funding Area
Worksheets("DC_price_calc").Cells(16, "A").PasteSpecial xlValues
Range(.Cells(i, "Q"), Cells(i, "Q")).Copy 'Capacity
Worksheets("DC_price_calc").Cells(16, "B").PasteSpecial xlValues
Range(.Cells(i, "DV"), Cells(i, "DV")).Copy 'LTP Calc Flag
Worksheets("DC_price_calc").Cells(7, "D").PasteSpecial xlValues
Range(.Cells(i, "BP"), Cells(i, "DC")).Copy 'CAPEX Costs
Worksheets("DC_price_calc").Cells(20, "D").PasteSpecial xlValues
GoalSeekV1
Range(.Cells(i, "E"), Cells(i, "E")).Copy 'Project ID
Worksheets("DC_Price_table").Cells(n, "A").PasteSpecial xlValues
Range(.Cells(i, "F"), Cells(i, "F")).Copy 'Project Name
Worksheets("DC_Price_table").Cells(n, "B").PasteSpecial xlValues
Range(.Cells(i, "BL"), Cells(i, "BL")).Copy 'Funding Area
Worksheets("DC_Price_table").Cells(n, "C").PasteSpecial xlValues
Range(.Cells(i, "Q"), Cells(i, "Q")).Copy 'Capacity
Worksheets("DC_Price_table").Cells(n, "D").PasteSpecial xlValues
Range(.Cells(i, "DV"), Cells(i, "DV")).Copy 'LTP Calc Flag
Worksheets("DC_Price_table").Cells(n, "E").PasteSpecial xlValues
Range("DC_Price").Copy
Worksheets("DC_Price_table").Cells(n, "F").PasteSpecial xlValues
Range(.Cells(i, "E"), Cells(i, "E")).Copy 'Project ID
Worksheets("Revenue_forecast_table").Cells(n, "A").PasteSpecial xlValues
Range(.Cells(i, "F"), Cells(i, "F")).Copy 'Project Name
Worksheets("Revenue_forecast_table").Cells(n, "B").PasteSpecial xlValues
Range(.Cells(i, "BL"), Cells(i, "BL")).Copy 'Funding Area
Worksheets("Revenue_forecast_table").Cells(n, "C").PasteSpecial xlValues
Range(.Cells(i, "Q"), Cells(i, "Q")).Copy 'Capacity
Worksheets("Revenue_forecast_table").Cells(n, "D").PasteSpecial xlValues
Range("DC_revenue_forecast").Copy 'DC Revenue Forecast
Worksheets("Revenue_forecast_table").Cells(n, "E").PasteSpecial xlValues
Range(.Cells(i, "E"), Cells(i, "E")).Copy 'Project ID
Worksheets("Interest_forecast_table").Cells(n, "A").PasteSpecial xlValues
Range(.Cells(i, "F"), Cells(i, "F")).Copy 'Project Name
Worksheets("Interest_forecast_table").Cells(n, "B").PasteSpecial xlValues
Range(.Cells(i, "BL"), Cells(i, "BL")).Copy 'Funding Area
Worksheets("Interest_forecast_table").Cells(n, "C").PasteSpecial xlValues
Range(.Cells(i, "Q"), Cells(i, "Q")).Copy 'Capacity
Worksheets("Interest_forecast_table").Cells(n, "D").PasteSpecial xlValues
Range("Interest_cost_forecast").Copy 'Interest Cost Forecast
Worksheets("Interest_forecast_table").Cells(n, "E").PasteSpecial xlValues
n = n + 1 'update so that we don't overwrite next time
End If
Next
End With
End Sub
Sub GoalSeekV1()
Dim rngStartGoal As Range
Set rngStartGoal = Range("DC_price_calc!$AQ$31")
Dim rngStartInput As Range
Set rngStartInput = Range("DC_Price")
rngStartGoal.GoalSeek Goal:=0, ChangingCell:=rngStartInput
End Sub
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|
