Dear all,
I have created my first ever code to do the following:
- Reset calculation
- Make copies of a "Master" sheet for all the listed cases
- make calculations for each case and each "drain rate" specified by the user.
This runs in loops.
I have tried to do this by looking at forums and recording macros in excel.
I have got very good tips from this site, so thank you very much for your time!
However, I think the code could run much faster - probably simplifying those parts from recorded macros in excel. I have done as much as possible, but still runs slow.
If anyone could give me some tips to make it run faster, I would be eternally grateful.
Here is the code:
Thank you!!!
E
I have created my first ever code to do the following:
- Reset calculation
- Make copies of a "Master" sheet for all the listed cases
- make calculations for each case and each "drain rate" specified by the user.
This runs in loops.
I have tried to do this by looking at forums and recording macros in excel.
I have got very good tips from this site, so thank you very much for your time!
However, I think the code could run much faster - probably simplifying those parts from recorded macros in excel. I have done as much as possible, but still runs slow.
If anyone could give me some tips to make it run faster, I would be eternally grateful.
Here is the code:
Code:
Sub Row_Data_for_each_case()
'Master sheet repeated for each case
Set myrange = Sheets("Cases_Input").Range("A4")
Set myrange = Range(myrange, myrange.End(xlDown))
With Application
.ScreenUpdating = False
' Reset calculation
Dim n As Long
n = ActiveWorkbook.Worksheets.Count
If n > 9 Then
For Each myCell In Sheets("Cases_Input").Range(myrange, myrange.End(xlDown))
' Delete cases sheets
Application.DisplayAlerts = False
Sheets(myCell.Value).Delete
Application.DisplayAlerts = True
Next myCell
End If
' Delete Output table content
Sheets("Calc Sheet").Select
Dim t As Integer
t = 0
Do Until Sheets("Calc Sheet").Cells(23, 2).Offset(6 * t, 0) = ""
Range("D25:Q28").Offset(6 * t, 0).Select
Selection.ClearContents
t = t + 1
Loop
Dim x As Integer
Dim lastrow As Long
x = 0
For Each myCell In myrange
With Sheets("Master")
.Visible = True
.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count) 'creates a new worksheet
End With
'ActiveWorkbook.Sheets("Master").Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = myCell.Value ' renames the new worksheet
Sheets(Sheets.Count).Activate
'Case names (SS and transient)
ActiveSheet.Range("B2").Value = myCell
ActiveSheet.Range("B3").Value = myCell.Offset(, 2)
'Copy table from Calc Sheet for each case(with DR user specifed and Min DR from QLT_SS_Input)
If Cells(2, 2) = Sheets("Calc Sheet").Cells(23, 2).Offset(6 * x, 0) Then
Sheets("Calc Sheet").Select
Range("D24:Q24").Offset(6 * x, 0).Select
Selection.Copy
Sheets(Sheets.Count).Select
Range("C5").Select
ActiveSheet.Paste
Else: MsgBox "Check correspondance between cases"
End If
' Copy trend in case worksheet
Sheets("ACCLIQ_T_Input").Select
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A3:b" & lastrow).Offset(, 2 * x).Copy
Sheets(Sheets.Count).Select
Range("a18").Select
ActiveSheet.Paste
' Headers
Range("A16").Select
Selection.Value = "Time [h]"
Range("B16").Select
Selection.Value = "ACCLIQ [m3]"
Range("A16:A17").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
Range("B16:B17").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
' Surge_Calc
Range("C16").Select
Selection.Value = "DeltaT [h]" ' Delta T
Range("D16").Select
Selection.Value = "DeltaV [m3]" ' Delta V
'Format
Range("C16:C17").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
Range("D16:D17").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
'Increments
Range("C19").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-R[-1]C[-2]" 'Delta T
Range("D19").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-R[-1]C[-2]" 'Delta V
Range("C19:D19").Select
Selection.AutoFill Destination:=Range("C19:D" & lastrow + 15)
'15 = 18 (paste row) - 3 (ACCLIQ trend from row 3)
Range("C15:D" & lastrow + 15).Select
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
End With
'Calculation for each DR
'Sheets(Sheets.Count).Select
Dim myColumn As Integer
Dim counter As Integer
myColumn = 1
counter = 0
Do Until (Cells(5, 3 + counter) = "")
Cells(16, myColumn + 4).Select
Selection.Value = "DeltaV-DR [m3]"
Range(Cells(16, myColumn + 4), Cells(17, myColumn + 4)).Select
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
With Selection.Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Cells(16, myColumn + 5).Select
Selection.Value = "SUM (DeltaV-DR) [m3]"
Range(Cells(16, myColumn + 5), Cells(17, myColumn + 5)).Select
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
With Selection.Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Cells(16, myColumn + 6).Select
Selection.Value = "DeltaSurge/DeltaT [m3/h]"
Range(Cells(16, myColumn + 6), Cells(17, myColumn + 6)).Select
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
With Selection.Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Cells(16, myColumn + 7).Select
Selection.Value = "Slug Vol. [m3]"
Range(Cells(16, myColumn + 7), Cells(17, myColumn + 7)).Select
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
With Selection.Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Cells(16, myColumn + 8).Select
Selection.Value = "Slug Duration [h]"
Range(Cells(16, myColumn + 8), Cells(17, myColumn + 8)).Select
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
With Selection.Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
' DeltaV-Drain Rate = accumulated volume in the separator
Cells(19, myColumn + 4).Select
Selection.FormulaR1C1 = "=RC4-(R5C" & 3 + counter & "*RC3)"
Selection.AutoFill Destination:=Range("E19:E" & lastrow + 15).Offset(, 5 * counter)
'Accumulated volume in the separator (only positive values)
Cells(19, myColumn + 5).Select
Selection.FormulaR1C1 = "=IF((R[-1]C+RC[-1])<0, 0, (R[-1]C+RC[-1]))"
Selection.AutoFill Destination:=Range("F19:F" & lastrow + 15).Offset(, 5 * counter)
'Delta Surge / Delta time
Cells(19, myColumn + 6).Select
Selection.FormulaR1C1 = "=(RC[-1]-R[-1]C[-1])/RC3"
Selection.AutoFill Destination:=Range("G19:G" & lastrow + 15).Offset(, 5 * counter)
' Slug Volume
Cells(19, myColumn + 7).Select
Selection.FormulaR1C1 = "=IF(AND(RC[-2]>0, RC[-1]>0), R[-1]C+RC4,0)"
Selection.AutoFill Destination:=Range("H19:H" & lastrow + 15).Offset(, 5 * counter)
'Slug Duration
Cells(19, myColumn + 8).Select
Selection.FormulaR1C1 = "=IF(RC[-1]=0,0, R[-1]C+RC3)"
Selection.AutoFill Destination:=Range("I19:I" & lastrow + 15).Offset(, 5 * counter)
'Range("I19:I" & lastrow + 15).Offset(0, 5 * counter).Select
Range("I15:I" & lastrow + 15).Offset(0, 5 * counter).Select
With Selection.Borders(xlRight)
.LineStyle = xlContinuos
.Weight = xlThick
End With
myColumn = myColumn + 5
counter = counter + 1
Loop
Sheets("Master").Visible = False
' Copy results in the output Table
Range("C7:P10").Select
Selection.Copy
Sheets("Calc Sheet").Select
Range("D25").Offset(6 * x, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.Font.Bold = False
Selection.NumberFormat = "0.00"
Selection.VerticalAlignment = xlCenter
Selection.HorizontalAlignment = xlRight
'Charts - Surge Volume and Slug Volume vs. time
Dim myChtObj1 As ChartObject
Dim myChtObj2 As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim y As Long
Dim z As Long
Sheets(Sheets.Count).Activate
' define chart's X values
Set rngChtXVal = ActiveSheet.Range("A19:A" & lastrow + 15)
' add the charts
Sheets(Sheets.Count).Activate
Set myChtObj1 = ActiveSheet.ChartObjects.Add(Left:=56, Width:=375, Top:=250, Height:=225)
Set myChtObj2 = ActiveSheet.ChartObjects.Add(Left:=56 * 10, Width:=375, Top:=250, Height:=225)
' Add series in chart1 - Surge volumes
With myChtObj1.Chart
' make an XY chartj
.ChartType = xlXYScatterLinesNoMarkers
' remove extra series
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
' add surge volumes series in chart 1
y = 0
z = 1
Do Until Cells(19, 6).Offset(0, 5 * y) = ""
With .SeriesCollection.NewSeries
.Values = rngChtXVal.Offset(0, 5 * z)
.XValues = rngChtXVal
.Name = "for" & " " & Cells(4, 3).Offset(0, 1 * y)
End With
y = y + 1
z = z + 1
Loop
End With
' Chart format - Surge Volumes
myChtObj1.Activate
With ActiveChart.Parent
.Height = 325 ' resize
.Width = 500 ' resize
End With
ActiveChart.PlotArea.Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
End With
ActiveChart.Axes(xlValue).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
End With
ActiveChart.Axes(xlCategory).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
End With
ActiveChart.Axes(xlCategory).HasMajorGridlines = True
ActiveChart.Axes(xlCategory).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineLongDashDot
End With
ActiveChart.Axes(xlValue).HasMajorGridlines = True
ActiveChart.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineLongDashDot
End With
With ActiveChart
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (h)"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Surge Volume (m3)"
End With
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "Surge Volumes vs. Time for Case" & " " & Cells(2, 2)
With Selection.Format.TextFrame2.TextRange.Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Size = 14
End With
ActiveChart.SetElement (msoElementLegendRight)
' Add series in chart2 - Slug Volumes
With myChtObj2.Chart
' make an XY chartj
.ChartType = xlXYScatterLinesNoMarkers
' remove extra series
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
'add slug volume series in chart 1
y = 0
z = 1
Do Until Cells(19, 8).Offset(0, 5 * y) = ""
With .SeriesCollection.NewSeries
.Values = rngChtXVal.Offset(0, 5 * z)
.XValues = rngChtXVal
.Name = "for" & " " & Cells(4, 3).Offset(0, 1 * y)
End With
y = y + 1
z = z + 1
Loop
End With
' Chart format - Slug Volumes
myChtObj2.Activate
With ActiveChart.Parent
.Height = 325 ' resize
.Width = 500 ' resize
End With
ActiveChart.PlotArea.Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
End With
ActiveChart.Axes(xlValue).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
End With
ActiveChart.Axes(xlCategory).HasMajorGridlines = True
ActiveChart.Axes(xlCategory).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineLongDashDot
End With
ActiveChart.Axes(xlValue).HasMajorGridlines = True
ActiveChart.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineLongDashDot
End With
With ActiveChart
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (h)"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Slug Volume (m3)"
End With
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "Slug Volumes vs. Time for Case" & Cells(2, 2)
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"Slug Volumes vs. Time for Case" & Cells(2, 2)
With Selection.Format.TextFrame2.TextRange.ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Size = 14
End With
ActiveChart.SetElement (msoElementLegendRight)
x = x + 1
Next myCell
.Sheets("Calc Sheet").Select
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End SubThank you!!!
E
