Could you help improve recorded macro

[Sean15]

Sub Macro2()

'

' Macro2 Macro

'



'

Range("P1").Select

ActiveCell.FormulaR1C1 = "Cost Center"

Range("Q1").Select

ActiveCell.FormulaR1C1 = "Division"

Range("R2").Select

ActiveCell.FormulaR1C1 = "1"

Range("R2").Select

Selection.Copy

Range("C2:C8").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _

SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range("P2").Select

ActiveCell.FormulaR1C1 = "=RIGHT(RC[-13],3)*1"

Range("P2").Select

Selection.AutoFill Destination:=Range("P2:P8"), Type:=xlFillDefault

Range("P2:P8").Select

Range("Q2").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(IFERROR(VLOOKUP(RC[-14],'lookup values'!R2C1:R27C2,2,0),VLOOKUP(RC[-1],'lookup values'!R2C1:R27C2,2,0)),"""")"

Range("Q2").Select

Selection.AutoFill Destination:=Range("Q2:Q8"), Type:=xlFillDefault

Range("Q2:Q8").Select

Range("M9").Select

ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-7]C:R[-1]C)"

Range("M10").Select

End Sub

Column C – I’m converting numbers formatted as text to numbers so I’d like “PasteSpecial *1 to extend to the last row of data, and not a range.

Column P – I’d like to extend formula to the last row of data, and not a range.

Column R – I had to add 1 in row R2 to help execute the PastSpecial*1 in column C. Is there a more efficient way to execute the PastSpecial*1 without adding 1 in R2?

Column Q - I’d like to extend formula to the last row of data, and not a range.

S2 – I added VLookup formula in S2 to help insert formula in column Q. Is there a better way to do this?

M9 - could we add subtotal to the row following the last row of data in column M

Thank you for your help.

 

[petertenthije]

Could you share some sample data?

Also, what's happening with cell R2?
First your macro adds 1 to R2, which is then copied over to C2:C8.
The result of C2:C8 is then used in the formula in R2:R8.
Presumably that's a mistake?

 

[petertenthije]

Sub Macro1()

' Set variables.
    WB = ActiveWorkbook.Name
    WS = ActiveSheet.Name
    lastrow = Workbooks(WB).Sheets(WS).Cells(Sheets(WS).Rows.Count, "C").End(xlUp).Row

' Add headers.
    Workbooks(WB).Sheets(WS).Range("P1").FormulaR1C1 = "Cost Center"
    Workbooks(WB).Sheets(WS).Range("Q1").FormulaR1C1 = "Division"

' Modify text to numbers in colu,n C.
    Set Rng = Workbooks(WB).Sheets(WS).Range("C2:C" & lastrow)
    For Each cel In Rng.Cells
        cel.Value = CSng(cel.Value)
    Next cel



    Workbooks(WB).Sheets(WS).Range("P2:P" & lastrow).FormulaR1C1 = "=RIGHT(RC[-13],3)"


' This formula can be simplified because of
' the calculation already done in column C.
' To use your own formula you can use:
'    Range("Q2:Q" & lastrow).FormulaR1C1 = "=IFERROR(IFERROR(VLOOKUP(RC[-14],'lookup values'!R2C1:R27C2,2,0),VLOOKUP(RC[-1],'lookup values'!R2C1:R27C2,2,0)),"""")"
' But the easier alternative would be:
    Workbooks(WB).Sheets(WS).Range("Q2:Q" & lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC3,'lookup values'!R2C1:R27C2,2,0),"""")"
' Keep in mind though, your formula assumes there
' will never be a change to the lookup values.
' Every time a row is added to the lookup values
' tables, the formula above will ignore the latest
' additions. The below formula will include any
' additions made to the lookup table.
    lastrow_vlookup = Workbooks(WB).Sheets("Lookup values").Cells(Sheets(WS).Rows.Count, "A").End(xlUp).Row
    Workbooks(WB).Sheets(WS).Range("Q2:Q" & lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC3,'lookup values'!R2C1:R" & lastrow_vlookup & "C2,2,0),"""")"

' Add subtotal below the last row of data in column M.
    Range("M" & lastrow + 1).FormulaR1C1 = "=SUBTOTAL(9,R2C:R" & lastrow & "C)"

End Sub

 

[Sean15]

Cost Center calculator - CopyA.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	Element	Cost element name	Center	CO object name	Document type	Name	Period	Name of offsetting account	Offsetting acct no.	Ref Document Number	Personnel Number	Created on	Val.in rep.cur.	Posting Date	Document Date	Cost Center	Division
2	822000	Executive	621203	Chains	CC		12	Xxxxxxxxx	341200	1080571BC	0	9/4/2024	-4,235.94	9/1/2024	9/4/2024			1	IFERROR(IFERROR(VLOOKUP(C2,'lookup values'!$A$2:$B$27,2,0),VLOOKUP(P2,'lookup values'!$A$2:$B$27,2,0)),"")
3	822000	Executive	621100	Chains	CC		12	Xxxxxxxxx	341200	1080571BC	0	9/4/2024	-4,326.93	9/1/2024	9/4/2024
4	822000	Executive	621407	Chains	CC		12	Xxxxxxxxx	341200	1080571BC	0	9/4/2024	-5,496.37	9/1/2024	9/4/2024
5	822000	Executive	621301	Chains	CC		12	Xxxxxxxxx	341200	1080571BC	0	9/4/2024	-2,626.92	9/1/2024	9/4/2024
6	822000	Executive	621506	Chains	CC		12	Xxxxxxxxx	341200	1080571BC	0	9/4/2024	-3,197.43	9/1/2024	9/4/2024
7	822000	Executive	621301	Chains	CC		12	Xxxxxxxxx	341200	1080571BC	0	9/4/2024	5,253.84	9/6/2024	9/4/2024
8	822000	Executive	621506	Chains	CC		12	Xxxxxxxxx	341200	1080571BC	0	9/4/2024	6,394.85	9/6/2024	9/4/2024
9													-8,234.90
Sheet1

Cell Formulas
Range	Formula
M9	M9	=SUBTOTAL(9,M2:M8)

Response:
R2 - I had to add 1 in row R2 to help execute the PastSpecial*1 in column C
Formula is in P2 = Right(P2,3)*1 - drag down to P8
Formula in Q2 = IFERROR(IFERROR(VLOOKUP(C2,'lookup values'!$A$2:$B$27,2,0),VLOOKUP(P2,'lookup values'!$A$2:$B$27,2,0)),"") - drag down to Q8

VBA code post #3 returned:
Run-time error ‘13’
Type mismatch

Debug highlights - cel.Value = CSng(cel.Value)

 

[petertenthije]

Strange, I do not get the runtime error. Maybe you can try this?

Sub Macro1()

' https://www.mrexcel.com/board/threads/could-you-help-improve-recorded-macro.1264384/

' Set variables.
    WB = ActiveWorkbook.Name
    WS = ActiveSheet.Name
    Dim lastrow As Integer
    Dim lastrow_vlookup As Integer
    lastrow = Workbooks(WB).Sheets(WS).Cells(Sheets(WS).Rows.Count, "C").End(xlUp).Row
    lastrow_vlookup = Workbooks(WB).Sheets("Lookup values").Cells(Sheets(WS).Rows.Count, "A").End(xlUp).Row

' Add headers.
    Workbooks(WB).Sheets(WS).Range("P1").FormulaR1C1 = "Cost Center"
    Workbooks(WB).Sheets(WS).Range("Q1").FormulaR1C1 = "Division"

' Modify text to numbers in colu,n C.
    Set Rng = Workbooks(WB).Sheets(WS).Range("C2:C" & lastrow)
    For Each cel In Rng.Cells
        cel.Value = CSng(cel.Value)
    Next cel

    Workbooks(WB).Sheets(WS).Range("P2:P" & lastrow).FormulaR1C1 = "=RIGHT(RC[-13],3)"

    Workbooks(WB).Sheets(WS).Range("Q2:Q" & lastrow).FormulaR1C1 = "=IFERROR(IFERROR(VLOOKUP(RC[-14],'lookup values'!R2C1:R" & lastrow_vlookup & "C2,2,0),VLOOKUP(RC[-1],'lookup values'!R2C1:R" & lastrow_vlookup & "C2,2,0)),"""")"


' Add subtotal below the last row of data in column M.
    Range("M" & lastrow + 1).FormulaR1C1 = "=SUBTOTAL(9,R2C:R" & lastrow & "C)"

End Sub

 

[Sean15]

Tried VBA codes in post #5.
Still getting:
Run-time error ‘13’
Type mismatch
Debug highlights - cel.Value = CSng(cel.Value)

 

[petertenthije]

In the Locals screen of VBA, what value do you get for "lastrow"?

 

[Sean15]

Is that what you mean?

 

[petertenthije]

Sub Macro1()

' https://www.mrexcel.com/board/threads/could-you-help-improve-recorded-macro.1264384/

' Set variables.
    WB = ActiveWorkbook.Name
    WS = ActiveSheet.Name
    Dim lastrow As Integer
    Dim lastrow_vlookup As Integer
    lastrow = Workbooks(WB).Sheets(WS).Cells(Sheets(WS).Rows.Count, "C").End(xlUp).Row
    lastrow_vlookup = Workbooks(WB).Sheets("Lookup values").Cells(Sheets(WS).Rows.Count, "A").End(xlUp).Row

' Add headers.
    Workbooks(WB).Sheets(WS).Range("P1").FormulaR1C1 = "Cost Center"
    Workbooks(WB).Sheets(WS).Range("Q1").FormulaR1C1 = "Division"

' Modify text to numbers in colu,n C.
    Set Rng = Workbooks(WB).Sheets(WS).Range("C2:C" & lastrow)
    For Each cel In Rng.Cells
        on error resume next
        cel.Value = CSng(cel.Value)
        on error goto 0
    Next cel

    Workbooks(WB).Sheets(WS).Range("P2:P" & lastrow).FormulaR1C1 = "=RIGHT(RC[-13],3)"

    Workbooks(WB).Sheets(WS).Range("Q2:Q" & lastrow).FormulaR1C1 = "=IFERROR(IFERROR(VLOOKUP(RC[-14],'lookup values'!R2C1:R" & lastrow_vlookup & "C2,2,0),VLOOKUP(RC[-1],'lookup values'!R2C1:R" & lastrow_vlookup & "C2,2,0)),"""")"


' Add subtotal below the last row of data in column M.
    Range("M" & lastrow + 1).FormulaR1C1 = "=SUBTOTAL(9,R2C:R" & lastrow & "C)"

End Sub

 

[Sean15]

Thank you. Executed codes in post #9.
1. Column C and col P - looks like numbers stored as text did not convert to numbers.
2. Subtotal should be in M9

Everything else looks good.

Cost Center calculator - TEST.xlsm
	A	B	C									L	M	N	O	P	Q
1	Element	Cost element name	Center									Created on	Val.in rep.cur.	Posting Date	Document Date	Cost Center	Division
2	822000	Executive	621203									9/4/2024	-4,235.94	9/1/2024	9/4/2024	203
3	822000	Executive	621100									9/4/2024	-4,326.93	9/1/2024	9/4/2024	100
4	822000	Executive	621407									9/4/2024	-5,496.37	9/1/2024	9/4/2024	407
5	822000	Executive	621301									9/4/2024	-2,626.92	9/1/2024	9/4/2024	301
6	822000	Executive	621506									9/4/2024	-3,197.43	9/1/2024	9/4/2024	506
7	822000	Executive	621301									9/4/2024	5,253.84	9/6/2024	9/4/2024	301
8	822000	Executive	621506									9/4/2024	6,394.85	9/6/2024	9/4/2024	506
9
10													-8234.9
Sheet1

Cell Formulas
Range	Formula
P2:P9	P2	=RIGHT(C2,3)
Q2:Q9	Q2	=IFERROR(IFERROR(VLOOKUP(C2,'lookup values'!$A$2:$B$27,2,0),VLOOKUP(P2,'lookup values'!$A$2:$B$27,2,0)),"")
M10	M10	=SUBTOTAL(9,M$2:M$9)