Is there a way to simplify my code to avoid having to copy the following code for each column?
I am able to loop through a range of rows within one column and apply a formula (in this case a countifs). How do i do apply the same for columns AA:AZ?
My current code is below:
Sub CountIfsFormula2()
Dim lstrow As Long
Dim i As Long
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationManual
lstrow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To lstrow
Range("C" & i).Formula = "=COUNTIFS('Agent_Detail_Data'!C,Sheet1!R1C3,'Agent_Detail_Data'!C[1],"">=""&Sheet1!RC[-1],'Agent_Detail_Data'!C[1],""<""&Sheet1!R[1]C[-1],'Agent_Detail_Data'!C[11],Sheet1!R1C1)"
Range("D" & i).Formula = "=COUNTIFS('Agent_Detail_Data'!C[-1],Sheet1!R1C4,'Agent_Detail_Data'!C,"">=""&Sheet1!RC[-2],'Agent_Detail_Data'!C,""<""&Sheet1!R[1]C[-2],'Agent_Detail_Data'!C[10],Sheet1!R1C1)"
Range("E" & i).Formula = "=COUNTIFS('Agent_Detail_Data'!C3,Sheet1!R1C5,'Agent_Detail_Data'!C[-1],"">=""&Sheet1!RC[-3],'Agent_Detail_Data'!C[-1],""<""&Sheet1!R[1]C[-3],'Agent_Detail_Data'!C[9],Sheet1!R1C1)"
Range("F" & i).Formula = "=COUNTIFS('Agent_Detail_Data'!C3,Sheet1!R1C6,'Agent_Detail_Data'!C[-2],"">=""&Sheet1!RC[-4],'Agent_Detail_Data'!C[-2],""<""&Sheet1!R[1]C[-4],'Agent_Detail_Data'!C[8],Sheet1!R1C1)"
Range("G" & i).Formula = "=COUNTIFS('Agent_Detail_Data'!C3,Sheet1!R1C7,'Agent_Detail_Data'!C[-3],"">=""&Sheet1!RC[-5],'Agent_Detail_Data'!C[-3],""<""&Sheet1!R[1]C[-5],'Agent_Detail_Data'!C[7],Sheet1!R1C1)"
Range("H" & i).Formula = "=COUNTIFS('Agent_Detail_Data'!C3,Sheet1!R1C8,'Agent_Detail_Data'!C[-4],"">=""&Sheet1!RC[-6],'Agent_Detail_Data'!C[-4],""<""&Sheet1!R[1]C[-6],'Agent_Detail_Data'!C[6],Sheet1!R1C1)"
Range("I" & i).Formula = "=COUNTIFS('Agent_Detail_Data'!C3,Sheet1!R1C9,'Agent_Detail_Data'!C[-5],"">=""&Sheet1!RC[-7],'Agent_Detail_Data'!C[-5],""<""&Sheet1!R[1]C[-7],'Agent_Detail_Data'!C[5],Sheet1!R1C1)"
Range("J" & i).Formula = "=COUNTIFS('Agent_Detail_Data'!C3,Sheet1!R1C10,'Agent_Detail_Data'!C[-6],"">=""&Sheet1!RC[-8],'Agent_Detail_Data'!C[-6],""<""&Sheet1!R[1]C[-8],'Agent_Detail_Data'!C[4],Sheet1!R1C1)"
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
End Sub
Related
I am running the following macro to copy down formulas on two hidden sheets.
With the sheets unhidden the code (excluding the later added .visible syntax below) worked. However, not when I hide the sheets.
My code with the not functioning unhide then hide attempt:
Sub TestMacro()
' Whse Tab
Sheets("Whse").Visable = True
Sheets("Whse").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2") = "=IF(A2=1,J2,J2+K1)"
Range("K2:K" & LastRow).FillDown
Range("L2") = "=H2-K2"
Range("L2:L" & LastRow).FillDown
Range("M2") = "=IF(L2>0,J2,J2+L2)"
Range("M2:M" & LastRow).FillDown
Range("N2") = "=IF(M2>0,1,2)"
Range("N2:N" & LastRow).FillDown
Sheets("Whse").Visable = False
' AllWhse Tab
Sheets("AllWhse").Visable = True
Sheets("AllWhse").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("J2") = "=IF(A2=1,I2,I2+J1)"
Range("J2:J" & LastRow).FillDown
Range("K2") = "=G2-J2"
Range("K2:K" & LastRow).FillDown
Range("L2") = "=IF(K2>0,I2,I2+K2)"
Range("L2:L" & LastRow).FillDown
Range("M2") = "=IF(L2>0,1,2)"
Range("M2:M" & LastRow).FillDown
Worksheets("AllWhse").Visable = False
' Refresh Workbook
ActiveWorkbook.RefreshAll
End Sub
Running Macro on Hidden Sheets
It is true that you can't select a hidden (not Visible) sheet, but that doesn't mean you can't modify it.
Option Explicit
Sub TestMacro()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim LastRow As Long
With wb.Worksheets("Whse")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("K2:K" & LastRow).Formula = "=IF(A2=1,J2,J2+K1)"
.Range("L2:L" & LastRow).Formula = "=H2-K2"
.Range("M2:M" & LastRow).Formula = "=IF(L2>0,J2,J2+L2)"
.Range("N2:N" & LastRow).Formula = "=IF(M2>0,1,2)"
End With
With wb.Worksheets("AllWhse")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("J2:J" & LastRow).Formula = "=IF(A2=1,I2,I2+J1)"
.Range("K2:K" & LastRow).Formula = "=G2-J2"
.Range("L2:L" & LastRow).Formula = "=IF(K2>0,I2,I2+K2)"
.Range("M2:M" & LastRow).Formula = "=IF(L2>0,1,2)"
End With
End Sub
I have the following code:
Sub CreateDisableLists()
Dim LastRow As Long
Dim i As Long
LastRow = Cells(Rows.Count, "J").End(xlUp).Row
For i = 2 To LastRow
If _
Range("G" & i).Value = "DSDFDFFD" And Range("I" & i).Value = "Enabled" Or _
Range("G" & i).Value = "SFDDS" And Range("I" & i).Value = "Enabled" Or _
Range("G" & i).Value = "FFDFDSSF" And Range("I" & i).Value = "Enabled" Or _
Range("G" & i).Value = "FDFDSVSFD" And Range("I" & i).Value = "Enabled" Or _
Range("G" & i).Value = "FDFDSFD" And Range("I" & i).Value = "Enabled" Or _
Range("G" & i).Value = "GHFH" And Range("I" & i).Value = "Enabled" _
Then
Range("K" & i).Value = "TRUE"
Else
Range("K" & i).Value = "FALSE"
End If
Next i
End Sub
How can I compress the lines between "If" and "Then" so that I loop through a list of (DSDFDFFD, SFDDS, FFDFDSSF, etc") instead of what is written above? Using this code I need to add 68 lines between "If" and "Then".
You could start by setting K to be FALSE, then using If on column I, and Select Case on column G:
Sub sCreateDisableLists()
Dim LastRow As Long
Dim i As Long
LastRow = Cells(Rows.Count, "J").End(xlUp).Row
For i = 2 To LastRow
Range("K" & i).Value = "FALSE"
If Range("I" & i).Value = "Enabled" Then
Select Case Range("G" & i).Value
Case "xxx1", "xxx2", "xxx3", "xxx4", "xxx5", "xxx6"
Range("K" & i).Value = "TRUE"
End Select
End If
Next i
End Sub
If using multiple Or/And statements I highly recommend to use parenthesis to group them as you want them to validate, or you might not get the result you expect.
Your If statement could be like:
Dim Arr() As Variant
Arr = Array("DSDFDFFD", "SFDDS", "FFDFDSSF") 'define your keys here
If Range("I" & i).Value = "Enabled" And IsInArray(Range("I" & i).Value, Arr) Then
Range("K" & i).Value = "TRUE"
Else
Range("K" & i).Value = "FALSE"
End If
or even less:
Dim Arr() As Variant
Arr = Array("DSDFDFFD", "SFDDS", "FFDFDSSF") 'define your keys here
Range("K" & i).Value = UCase(Range("I" & i).Value = "Enabled" And IsInArray(Range("I" & i).Value, Arr))
using this function
Public Function IsInArray(ByVal stringToBeFound As String, ByVal Arr As Variant) As Boolean
IsInArray = (UBound(Filter(Arr, stringToBeFound)) > -1)
End Function
You could try:
Option Explicit
Sub CreateDisableLists()
Dim LastRow As Long, i As Long, y As Long
Dim strValues As String: strValues = "DSDFDFFD,SFDDS,FFDFDSSF,FDFDSVSFD,FDFDSFD,GHFH"
Dim strIvalue As String: strIvalue = "Enabled"
Dim arr As Variant
Dim BooleanStatus As Boolean
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
arr = Split(strValues, ",")
For i = 2 To LastRow
BooleanStatus = False
For y = LBound(arr) To UBound(arr)
If (.Range("G" & i).Value = arr(y)) And .Range("I" & i).Value = strIvalue Then
BooleanStatus = True
Exit For
End If
Next y
If BooleanStatus = True Then
.Range("K" & i).Value = "TRUE"
Else
.Range("K" & i).Value = "FALSE"
End If
Next i
End With
End Sub
Not very much to be improved, but the next code would be a little more compact:
Sub testImproveCode()
Dim LastRow As Long, i As Long
Dim j As Long, boolOk As Boolean
LastRow = Cells(Rows.count, "J").End(xlUp).Row
For i = 2 To LastRow
For j = 1 To 6
If Range("G" & i).value = "xxx" & j And _
Range("I" & i).value = "Enable" Then
boolOk = True: Exit For
Next j
If boolOk Then
Range("K" & i).value = "TRUE": boolOk = False
Else
Range("K" & i).value = "FALSE"
End If
Next i
End Sub
I am trying to combine a vlookup formula with an If condition. To be more exact, I have a worksheet where I want a vlookup formula to be executed in the cell of the column G if the cell of the column E AND F is 0. Just to be clear, the variable lastrow3 and ws1 are WELL defined and have proper values. Also, I have run the code without the if condition (just the vlookup) and it runs just fine. So there is no chance that there is an issue with these variables. Moreover, I want the vlookup to be dynamic. I have written 4 different types of code. I am providing them below.
CODE1
For i = 2 To lastrow3
ws1.Range("G" & i).Formula = "=IF(E" & i & "+ F" & i & " = 0, " & Chr(34) & "VLOOKUP(C"&i&",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE)" & Chr(34) & ", " & Chr(34) & "No" & Chr(34) & ")"
Next i
This code gives me an error in this part: "VLOOKUP(C"&i&",saying that there is a syntax error.
CODE2
For Each cell In ws1.Range("G2:G" & lastrow3)
If cell.Offset(0, -1).Value = 0 Then
If cell.Offset(0, -2).Value = 0 Then
cell.Formula = "=IFERROR(VLOOKUP(C2,'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
End If
End If
Next cell
This code gives an error in this part: If cell.Offset(0, -1).Value = 0 Then saying that there is type mismatch. Also, this code does not have dynamic vlookup, so it vlookups only for cell C2.
CODE3
With ws1
For i = 2 To lastrow3
If .Cells(i, "E").Value2 = 0 And .Cells(i, "F").Value2 = 0 Then
.Cells(i, "G").Formula = "=IFERROR(VLOOKUP($C$" & i&",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
End If
Next cell
End With
This code gives me an error in this part : .Cells(i, "G").Formula = "=IFERROR(VLOOKUP($C$" & i&",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")" saying the there is a syntax error.
CODE4
With ws1
.Range("G2:G" & lastrow3).Formula = "=IFERROR(VLOOKUP(C2,'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
.Range("G2:G" & lastrow3).Value = .Range("G2:G" & lastrow3).Value
End With
This code runs fine (this is the code I ran and verified that the variables are well defined) bit does not include the If condition.
I want to declare that this code runs really fast (with the With ws1 and End With) so if it is possible to make this code ran by adding the if condition then it would be perfect.
CODE5 (-> my attempt at adding If condition in CODE4)
With ws1
If .Range("G2:G" & lastrow3).Offset(0, -1).Value = 0 And .Range("G2:G" & lastrow3).Offset(0, -2).Value = 0 Then
.Range("G2:G" & lastrow3).Formula = "=IFERROR(VLOOKUP(C2,'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
End If
.Range("G2:G" & lastrow3).Value = .Range("G2:G" & lastrow3).Value
End With
This code gives me an error in this part : If .Range("G2:G" & lastrow3).Offset(0, -1).Value = 0 And .Range("G2:G" & lastrow3).Offset(0, -2).Value = 0 Then saying that there is an type mismatch.
SUMMARY
I am trying to combine speed and accuracy in the code. The code with the With and End With, from what I have searched, is the fastest. However, If I manage to solve it with another code then no issue. The main errors I get is in the vlookup formula, when I try to make it dynamic and in the if condition, when I try to find whether the offsets have 0 values.
I am adding the entire code so far (although I think it is not important)
ENTIRE CODE
Sub Pharma_Stock_Report()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim lastrow3 As Long
Dim CopyRange As Range
Dim i As Long
spath1 = Application.ThisWorkbook.Path & "\Pharma replenishment.xlsm"
spath2 = Application.ThisWorkbook.Path & "\NOT OK.xlsx"
Workbooks.Open spath1
Workbooks.Open spath2
Set ws1 = Workbooks("Pharma Stock Report.xlsm").Worksheets("Pharma Stock Report")
Set ws2 = Workbooks("Pharma replenishment.xlsm").Worksheets("Replenishment")
Set ws3 = Workbooks("NOT OK.xlsx").Worksheets("Sheet1")
With ws1
.Cells.Clear
End With
With ws2
lastrow1 = .Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To lastrow1
If .Cells(i, "D").Interior.ColorIndex = -4142 Or .Cells(i, "D").Interior.ColorIndex = 2 Then
If CopyRange Is Nothing Then
Set CopyRange = .Range("A" & i & ":F" & i)
Else
Set CopyRange = Union(CopyRange, .Range("A" & i & ":F" & i))
End If
End If
Next i
End With
CopyRange.Copy
With ws1.Range("A2")
.PasteSpecial xlPasteValues
End With
ws2.Range("A4:F4").Copy
With ws1.Range("A1")
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Workbooks("Pharma replenishment.xlsm").Close
ws3.Range("I1").Copy
With ws1.Range("G1")
.PasteSpecial xlPasteValues
End With
lastrow3 = ws1.Range("D" & Rows.Count).End(xlUp).Row
With ws1
.Range("G2:G" & lastrow3).Formula = "=IFERROR(VLOOKUP(C2,'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
.Range("G2:G" & lastrow3).Value = .Range("G2:G" & lastrow3).Value
End With
Application.CutCopyMode = False
Workbooks("NOT OK.xlsx").Close
With ws1.Range("A1:G" & lastrow3)
.HorizontalAlignment = xlCenter
.Font.Color = vbBlack
.Font.Name = "Calibri"
.Font.Italic = False
.Borders.LineStyle = xlDouble
.Borders.Weight = xlThin
.Borders.Color = vbBlack
End With
With ws1.Range("A1:G1")
.Interior.ColorIndex = 41
.Font.Bold = True
.Font.Size = 14
.Font.Italic = True
End With
With ws1.Range("A1", Range("A1").End(xlDown).End(xlToRight))
.EntireColumn.AutoFit
End With
ws1.Range("A1:G1").AutoFilter
ws1.AutoFilter.Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws1.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
CODE1 has some issues. You've inserted some Chr(34) around the VLOOKUP and unless you want the cell to display the lookup formula, instead of the result of the lookup then they need to go.
ws1.Range("G" & i).Formula = "=IF(E" & i & "+ F" & i & " = 0, " & "VLOOKUP(C" & i & ",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE)" & ", " & Chr(34) & "No" & Chr(34) & ")"
To blank out zeros and #N/A -
ws1.Range("G" & i).Formula = "=IFNA(IF(E" & i & "+ F" & i & " = 0, " & "IF(IFNA(VLOOKUP(C" & i & ",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),0)=0,"""",IFNA(VLOOKUP(C" & i & ",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),0))" & ", " & Chr(34) & "No" & Chr(34) & "),"""")"
The first code is an easy fix: there actually is a syntax error, as vba requires spaces between variable names and the &-Operator. Adding spaces like
ws1.Range("G" & i).Formula = "=IF(E" & i & "+ F" & i & " = 0, " & Chr(34) & "VLOOKUP(C" & i & ",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE)" & Chr(34) & ", " & Chr(34) & "No" & Chr(34) & ")"
will solve that problem.
Your current code is testing a range of values which is likely why you are getting type issues
Instead it would be easier to add the if test in the formula (Then using R1C1 notation to create referenced lookups)
.Range("G2:G" & lastrow3).FormulaR1C1 = "=IF(AND(RC[-2]=0,RC[-1]=0),IFERROR(VLOOKUP(RC[-4],'[NOT OK.xlsx]Sheet1'!C[-1]:C[2],4,FALSE),""""),"Null Values")"
I have a workbook like so:
Column A U
Supplier A 10
Supplier B 1
Supplier C 5
Supplier D 9
I am trying to highlight the entire row in red, only for the top 10 numbers in column B.
Here is my conditional formatting rule:
For some reaason the rows are only changing font colour, and the row is not highlighted. I reckon this has something to do with me turning off calculations?
My vba code includes:
Option Explicit
Sub code()
MsgBox "This will take upto 3 minutes."
Application.ScreenUpdating = False
Dim WB As Workbook
Dim i As Long
Dim j As Long
Dim Lastrow As Long
On Error Resume Next
Set WB = Workbooks("L.O. Lines Delivery Tracker.xlsm")
On Error GoTo 0
If WB Is Nothing Then 'open workbook if not open
Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) L.O. Delivery Tracking\L.O. Lines Delivery Tracker.xlsm")
End If
' ======= Edit #2 , also for DEBUG ======
With WB.Worksheets(1)
Lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
j = 2
For i = 7 To Lastrow
' === For DEBUG ONLY ===
Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F9").value)
Debug.Print Month(.Range("G" & i).value)
Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F10").value)
Debug.Print Year(.Range("G" & i).value)
Debug.Print ThisWorkbook.Worksheets(1).Range("B6").value
Debug.Print .Range("M" & i).value
If CInt(ThisWorkbook.Worksheets(1).Range("F9").value) = Month(.Range("G" & i).value) Then ' check if Month equals the value in "A1"
If CInt(ThisWorkbook.Worksheets(1).Range("F10").value) = Year(.Range("G" & i).value) Then ' check if Year equals the value in "A2"
If ThisWorkbook.Worksheets(1).Range("B6").value = .Range("M" & i).value Then
ThisWorkbook.Worksheets(2).Range("A" & j).value = .Range("G" & i).value
ThisWorkbook.Worksheets(2).Range("B" & j).Formula = "=MONTH(B" & j & ")"
ThisWorkbook.Worksheets(2).Range("C" & j).value = .Range("L" & i).value
ThisWorkbook.Worksheets(2).Range("D" & j).value = .Range("D" & i).value
ThisWorkbook.Worksheets(2).Range("E" & j).value = .Range("E" & i).value
ThisWorkbook.Worksheets(2).Range("F" & j).value = .Range("F" & i).value
ThisWorkbook.Worksheets(2).Range("g" & j).value = .Range("p" & i).value
ThisWorkbook.Worksheets(2).Range("H" & j).value = .Range("H" & i).value
ThisWorkbook.Worksheets(2).Range("I" & j).value = .Range("I" & i).value
ThisWorkbook.Worksheets(2).Range("J" & j).value = .Range("J" & i).value
ThisWorkbook.Worksheets(2).Range("k" & j).value = .Range("Q" & i).value
ThisWorkbook.Worksheets(2).Range("L" & j).value = .Range("m" & i).value
j = j + 1
End If
End If
End If
Next i
End With
Worksheets(1).UsedRange.Columns("B:AA").Calculate
On Error GoTo Message
With ThisWorkbook.Worksheets(1) '<--| change "mysheet" to your actual sheet name
Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).WrapText = True
Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).EntireRow.AutoFit
End With
'End
Application.ScreenUpdating = True
Exit Sub
Message:
On Error Resume Next
Exit Sub
End Sub
And
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
And
Private Sub Workbook_Open()
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
Please can someone show me where i am going wrong?
Please try:
Sub CF()
Cells.Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND($B1>=LARGE($B:$B,10),ROW()<>1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.Interior.Color = 255
.StopIfTrue = False
End With
End Sub
I'm puzzled to why my code overshoots the last row. If I run it on a worksheet with 30,000 rows it fills down to about 300k. This sheet calculates all my clients trades. Little confused at which way would be the most efficient way to calculate, use a vlookup function on each row which i insert using VBA or by using VBA to just calculate the total and display in a cell. Here's my code:
Sub UPDATE()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
lastRow = Sheets("Closed Trades").Range("A" & Rows.Count).End(xlUp).Row
lastRow2 = Sheets("Open Orders").Range("A" & Rows.Count).End(xlUp).Row
With Sheets("Closed Trades")
.Range("Q3:Q3" & lastRow).FormulaR1C1 = "=SUBSTITUTE(LEFT(RC[-13],10),""."",""/"")"
.Range("R3:R3" & lastRow).FormulaR1C1 = "=SUBSTITUTE(LEFT(RC[-9],10),""."",""/"")"
.Range("S3:S3" & lastRow).FormulaR1C1 = "=VLOOKUP(RC[-13],'Symbols & Spreads'!C[-18]:C[-16],3,FALSE)"
.Range("T3:T3" & lastRow).FormulaR1C1 = "=VLOOKUP(RC[-14],'Symbols & Spreads'!C[-19]:C[-14],6,FALSE)"
.Range("U3:U3" & lastRow).FormulaR1C1 = "=VLOOKUP(RC[-15],'Symbols & Spreads'!C[-20]:C[-13],8,FALSE)*RC[-14]"
.Range("V3:V3" & lastRow).FormulaR1C1 = "=IF(RC[-2]=""eur"",RC[-1]*R6C25,RC[-1]/(VLOOKUP(RC[-2],C[2]:C[3],2,FALSE)))"
End With
With Sheets("Open Orders")
.Range("T3:T3" & lastRow2).FormulaR1C1 = "=SUBSTITUTE(LEFT(RC[-17],10),""."",""/"")"
.Range("U3:U3" & lastRow2).FormulaR1C1 = "=VLOOKUP(RC[-16],'Symbols & Spreads'!C[-20]:C[-18],3,FALSE)"
.Range("V3:V3" & lastRow2).FormulaR1C1 = "=VLOOKUP(RC[-17],'Symbols & Spreads'!C[-21]:C[-16],6,FALSE)"
.Range("W3:W3" & lastRow2).FormulaR1C1 = "=VLOOKUP(RC[-18],'Symbols & Spreads'!C[-22]:C[-15],8,FALSE)*RC[-17]"
.Range("X3:X3" & lastRow2).FormulaR1C1 = "=IF(RC[-2]=""eur"",RC[-1]*R6C27,RC[-1]/(VLOOKUP(RC[-2],C[2]:C[3],2,FALSE)))"
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
You must replace:
.Range("Q3:Q3" & lastRow)
with:
.Range("Q3:Q" & lastRow)
etc.
The extra 3 is the problem.
You can try by changing
lastRow = Sheets("Closed Trades").Range("A" & Rows.Count).End(xlUp).Row
to
lastRow = Sheets("Closed Trades").Range("A1").End(xlDown).Row
AND
.Range("Q3:Q3" & lastRow).FormulaR1C1 = "=SUBSTITUTE(LEFT(RC[-13],10),""."",""/"")"
to
.Range("Q3:Q" & lastRow).FormulaR1C1 = "=SUBSTITUTE(LEFT(RC[-13],10),""."",""/"")"