Could you help improve recorded macro

Sean15 · Sunday at 2:52 PM

VBA Code:

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 · Sunday at 3:36 PM

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 · Sunday at 3:57 PM

VBA Code:

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 · Sunday at 4:47 PM

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 · Sunday at 4:59 PM

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

VBA Code:

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 · Sunday at 5:18 PM

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

petertenthije · Sunday at 5:26 PM

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

Sean15 · Sunday at 7:20 PM

Is that what you mean?

petertenthije · Monday at 5:00 AM

VBA Code:

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 · Monday at 9:09 AM

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)

Could you help improve recorded macro

Sean15

Well-known Member

Excel Facts

petertenthije

Active Member

petertenthije

Active Member

Sean15

Well-known Member

petertenthije

Active Member

Sean15

Well-known Member

petertenthije

Active Member

Sean15

Well-known Member

petertenthije

Active Member

Sean15

Well-known Member

Similar threads

Forum statistics

Share this page

Could you help improve recorded macro

Well-known Member

Excel Facts

Active Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock