Could you help improve recorded macro

Sean15

Sean15

Well-known Member
Joined
Jun 25, 2005
Messages
719
Office Version
  1. 2010
Platform
  1. Windows
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.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
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?
 
Upvote 0
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
 
Upvote 0
Cost Center calculator - CopyA.xlsm
ABCDEFGHIJKLMNOPQRS
1ElementCost element nameCenterCO object nameDocument typeNamePeriodName of offsetting accountOffsetting acct no.Ref Document NumberPersonnel NumberCreated onVal.in rep.cur.Posting DateDocument DateCost CenterDivision
2822000Executive 621203ChainsCC12Xxxxxxxxx3412001080571BC09/4/2024-4,235.949/1/20249/4/20241IFERROR(IFERROR(VLOOKUP(C2,'lookup values'!$A$2:$B$27,2,0),VLOOKUP(P2,'lookup values'!$A$2:$B$27,2,0)),"")
3822000Executive 621100ChainsCC12Xxxxxxxxx3412001080571BC09/4/2024-4,326.939/1/20249/4/2024
4822000Executive 621407ChainsCC12Xxxxxxxxx3412001080571BC09/4/2024-5,496.379/1/20249/4/2024
5822000Executive 621301ChainsCC12Xxxxxxxxx3412001080571BC09/4/2024-2,626.929/1/20249/4/2024
6822000Executive 621506ChainsCC12Xxxxxxxxx3412001080571BC09/4/2024-3,197.439/1/20249/4/2024
7822000Executive 621301ChainsCC12Xxxxxxxxx3412001080571BC09/4/20245,253.849/6/20249/4/2024
8822000Executive 621506ChainsCC12Xxxxxxxxx3412001080571BC09/4/20246,394.859/6/20249/4/2024
9-8,234.90
Sheet1
Cell Formulas
RangeFormula
M9M9=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)
 
Upvote 0
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
 
Upvote 0
Tried VBA codes in post #5.
Still getting:
Run-time error ‘13’
Type mismatch
Debug highlights - cel.Value = CSng(cel.Value)
 
Upvote 0
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
 
Upvote 0
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
ABCLMNOPQ
1ElementCost element nameCenterCreated onVal.in rep.cur.Posting DateDocument DateCost CenterDivision
2822000Executive 6212039/4/2024-4,235.949/1/20249/4/2024203 
3822000Executive 6211009/4/2024-4,326.939/1/20249/4/2024100 
4822000Executive 6214079/4/2024-5,496.379/1/20249/4/2024407 
5822000Executive 6213019/4/2024-2,626.929/1/20249/4/2024301 
6822000Executive 6215069/4/2024-3,197.439/1/20249/4/2024506 
7822000Executive 6213019/4/20245,253.849/6/20249/4/2024301 
8822000Executive 6215069/4/20246,394.859/6/20249/4/2024506 
9  
10-8234.9
Sheet1
Cell Formulas
RangeFormula
P2:P9P2=RIGHT(C2,3)
Q2:Q9Q2=IFERROR(IFERROR(VLOOKUP(C2,'lookup values'!$A$2:$B$27,2,0),VLOOKUP(P2,'lookup values'!$A$2:$B$27,2,0)),"")
M10M10=SUBTOTAL(9,M$2:M$9)
 
Upvote 0
You must log in or register to reply here.

Similar threads

Dazzawm
  • Solved
Change Range To Recorded Macro
Replies
3
Views
189
Alex Blakenburg
A
D
  • Solved
Insert formula in last column macro
2
Replies
13
Views
215
MARK858
MARK858
S
  • Solved
VBA autofilling code
Replies
6
Views
596
Peter_SSs
Peter_SSs
T
  • Question Question
ActiveSheet. Paste error
Replies
1
Views
354
RoryA
RoryA
P
  • Question Question
Help with Vba Code
Replies
3
Views
478
Coyotex3
C

Forum statistics

Threads
1,224,811
Messages
6,181,080
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top