Copy Sheet made from code or run code again

MeisterConrad

New Member
Joined
Jan 17, 2017
Messages
39
Office Version
  1. 2007
I've been working on a mammoth accounting project. To help, I've created a Macro that creates a new Sheet for a new Account, renames the Sheet, creates a Table as a Ledger, and uses other cells to retrieve info from other Sheets.

My problem comes from the part of the Macro that copies the Sheet and duplicates it for further new Accounts. The cells that retrieve info from other Sheets all stay the same; I need them to change. For example, with the refenced cell being E5 on the first Sheet, it would need to be E6 on the next Sheet. And this needs to be done for different columns of data. By this I mean that, as in the example, refenced cells are not always in row 5; whereas E5 would progress to the next Sheet as E6, another referenced cell would progress from G8 on the first Sheet to G9 on the next, and so on.

I figure there's gotta be a way to make my Macro more generic, using variables for the stuff that needs to change. That way, the Sheet is not being duplicated; it's a whole other sheet that's being created by running through the Macro again and again.
So, my weaknesses are two-fold. 1) I'm not so good with the how to name and embed the variables, and 2) the several For/Next loops that I'm supposing I'll have to use make my head spin; I'm ok with when I use just one For/Next loop, but when there's many, I get completely lost in the order/nesting.

And if anybody's got suggestions to make the code more efficient/elegant, I'm totally interested.

Any help is appreciated. Thanx.

VBA Code:
Sub Macro3()

' Macro3 Macro
' This Macro builds the Ledger1Sheet.
'
' Rename Sheet3 as Ledger1Sheet, Format all text to Century Gothic, size10.
'
'

'
    Dim AcRef As Integer



    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Ledger1Sheet"
    Cells.Select
    With Selection.Font
        .Name = "Century Gothic"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Century Gothic"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
' Input data into specific cells for the Ledger1Table.
'
' PageTitle/Heading...
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "LedgerSheet - Account #:"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "X"
    Selection.Font.Bold = True
    Selection.Font.Italic = True
    Selection.Font.Size = 14
        
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "Click here to data-sort the Table."
    Selection.Font.Bold = True
    Selection.Font.Italic = True
    
    Range("D5").Select
    ActiveCell.FormulaR1C1 = "Re-ceipt?"
    Range("E5").Select
    ActiveCell.FormulaR1C1 = "Trans-action Date"
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "Date Cleared"
    Range("G5").Select
    ActiveCell.FormulaR1C1 = "Budget Category"
    Range("H5").Select
    ActiveCell.FormulaR1C1 = "Sub-Category"
    Range("I5").Select
    ActiveCell.FormulaR1C1 = "To/From"
    Range("J5").Select
    ActiveCell.FormulaR1C1 = "VIA?"
    Range("K5").Select
    ActiveCell.FormulaR1C1 = "Debits"
    Range("L5").Select
    ActiveCell.FormulaR1C1 = "Credits"
    Range("M5").Select
    ActiveCell.FormulaR1C1 = "Operating Balance"
    Range("N5").Select
    ActiveCell.FormulaR1C1 = "Actual Balance"
    
    
' Create Ledger1Table, then build the Data-sort bar, and format
'
    Range("D5:N8").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$D$5:$N$8"), , xlYes).Name = _
        "Table3"
    Range("Table3[#All]").Select
    ActiveWorkbook.Names.Add Name:="Ledger1Table", RefersToR1C1:="=Table3"

    Range("D4:N4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Selection.Merge

Range("D4:N8").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

    
    Rows("5:5").RowHeight = 28
    Range("Table3[#Headers]").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    
' Format Table colors and borders.
    Range("Ledger1Table").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
' format column widths.
'
    Columns("A:C").ColumnWidth = 2.56
    Columns("D:D").ColumnWidth = 5.89
    Columns("E:F").ColumnWidth = 8.11
    Columns("G:G").ColumnWidth = 15.89
    Columns("H:H").ColumnWidth = 13.67
    Columns("I:I").ColumnWidth = 25.89
    Columns("J:J").ColumnWidth = 5.89
    Columns("K:L").ColumnWidth = 10.33
    Columns("M:N").ColumnWidth = 10.33
    Columns("O:S").ColumnWidth = 2.56
    Columns("T:U").ColumnWidth = 1.44
    Columns("V:V").ColumnWidth = 27
    Columns("W:W").ColumnWidth = 19.22
    Columns("X:X").ColumnWidth = 1.44
    Columns("Y:Y").ColumnWidth = 22.56
    Columns("Z:Z").ColumnWidth = 38.11
    Columns("AA:AA").ColumnWidth = 1.44
    Columns("AB:AB").ColumnWidth = 2.56
    Range("Table3[[#Headers],[Operating Balance]:[Actual Balance]]").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With

' enter formula into operating balance column.
'
    Range("M6").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(Table3[[#This Row],[Debits]]="""",Table3[[#This Row],[Credits]]=""""),"""",IF(Table3[[#This Row],[Debits]]<>"""",R[-1]C-Table3[[#This Row],[Debits]],R[-1]C+Table3[[#This Row],[Credits]]))"

    Range("N6").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(Table3[[#This Row],[Debits]]="""",Table3[[#This Row],[Credits]]=""""),"""",IF(Table3[[#This Row],[Debits]]<>"""",R[-1]C-Table3[[#This Row],[Debits]],R[-1]C+Table3[[#This Row],[Credits]]))"
    
 
' Building Meta-Data Summary.
' T4 thru AD18 format black.  U5 thru AC17 format as sky blue.
'
 
    Range("T4:AD18").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Range("U5:AC17").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    
    Range("V6:V12,V14:V16,Y6:Y11,Y14:Y16").Select
    Range("Y14").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("W6:W12,W14:W16,Z6:Z11,Z14:Z16").Select
    Range("Z14").Activate
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("Y6:Z11,Y14:Z16,V14:W16,V6:W12").Select
    Range("W6").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
    Range("V5").Select
    ActiveCell.FormulaR1C1 = "Meta-Data Summary"
        Selection.Font.Bold = True
        Selection.Font.Italic = True
        Selection.Font.Size = 14
    Range("V6").Select
    ActiveCell.FormulaR1C1 = "Account Name"
    Range("V7").Select
    ActiveCell.FormulaR1C1 = "Current Balance"
    Range("V8").Select
    ActiveCell.FormulaR1C1 = "Monthlies?"
    Range("V9").Select
    ActiveCell.FormulaR1C1 = "Monthlies Due Date"
    Range("V10").Select
    ActiveCell.FormulaR1C1 = "Cycle Begin Date"
    Range("V11").Select
    ActiveCell.FormulaR1C1 = "Cycle End Date"
    Range("V12").Select
    ActiveCell.FormulaR1C1 = "Monthlies Amount"
    Range("V14").Select
    ActiveCell.FormulaR1C1 = "Interest Bearing?"
    Range("V15").Select
    ActiveCell.FormulaR1C1 = "Interest Rate (APR)"
    Range("V16").Select
    ActiveCell.FormulaR1C1 = "Calculated Daily Interest Rate"


' Formulae for Meta-Data Summary.
    Range("W6").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!E4"
    Range("W7").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!V4"
    Range("W8").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!W4"
    Range("W9").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!X4"
    Range("W10").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!O4"
    Range("W11").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!P4"
    Range("W12").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!Y4"
        
    Range("W14").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!K4"
    Range("W15").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!M4"
    Range("W16").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!N4"
        
        
    Range("Y6").Select
    ActiveCell.FormulaR1C1 = "Issuing Institution"
    Range("Y7").Select
    ActiveCell.FormulaR1C1 = "Account Number"
    Range("Y8").Select
    ActiveCell.FormulaR1C1 = "Routing Number"
    Range("Y9").Select
    ActiveCell.FormulaR1C1 = "Account Type"
    Range("Y10").Select
    ActiveCell.FormulaR1C1 = "Sub-Type"
    Range("Y11").Select
    ActiveCell.FormulaR1C1 = "Credit Limit"
    Range("Y14").Select
    ActiveCell.FormulaR1C1 = "Prime Rate"
    Range("Y15").Select
    ActiveCell.FormulaR1C1 = "Prime Rate As-Of Date"
    Range("Y16").Select
    ActiveCell.FormulaR1C1 = "Interest Equation"
        
        
    Range("Z6").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!F4"
    Range("Z7").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!G4"
    Range("Z8").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!H4"
    Range("Z9").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!I4"
    Range("Z10").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!J4"
    Range("Z11").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!L4"
    Range("Z14").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!Q4"
    Range("Z15").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!R4"
    Range("Z16").Select
    ActiveCell.FormulaR1C1 = _
        "=AccountInfoSheet!U4"

' Data-Validation to various columns.
'
'
    Range("Table3[Re-ceipt?]").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=YesNoList"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    Range("Table3[Trans-action Date]").Select
    Selection.NumberFormat = "m/d;@"
    
    Range("Table3[Date Cleared]").Select
    Selection.NumberFormat = "m/d;@"
    
    Range("Table3[Budget Category]").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=BudgetingCategoriesList"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    Range("Table3[Sub-Category]").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=INDIRECT(BudgetingCategoriesList)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    Range("Table3[VIA?]").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=VIAList"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With



' Copy/paste LedgerSheet.
    Sheets("Ledger1Sheet").Select
    Sheets("Ledger1Sheet").Copy After:=Sheets(3)
    Sheets("Ledger1Sheet (2)").Select
    Sheets("Ledger1Sheet (2)").Name = "Ledger2Sheet"
' rename ledgertable.
    ActiveSheet.ListObjects("Table35").Name = "Table4"
  
' Copy/paste LedgerSheet.
    Sheets("Ledger1Sheet").Select
    Sheets("Ledger1Sheet").Copy After:=Sheets(4)
    Sheets("Ledger1Sheet (2)").Select
    Sheets("Ledger1Sheet (2)").Name = "Ledger3Sheet"
' rename ledgertable.
    ActiveSheet.ListObjects("Table36").Name = "Table5"
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
I've been working on a mammoth accounting project ....
You might be making life hard for yourself ....

1) You're using VBA code to create a template - setting formulae, formatting etc. Why not start with a template sheet in Excel? Very easy then for the project team to customise to their hearts' content. And very easy to amend subsequently.

2) Your VBA code is littered with hard-coded cell references. If anyone starts inserting/deleting rows/columns, you'll have a terrible job updating your code to accommodate this. An Excel template sheet will automatically adjust for layout changes.

3) How are you going to track that if Account #ABC points to SomeSheet!G4 and SomeOtherSheet!H8, you need Account #PDQ to point three rows down, say, i.e. to SomeSheet!G7 and SomeOtherSheet!H11. Surely there must be Account number columns in these other sheets to point you to the right rows?

4) Do you really need separate sheets for every account number? You can set up your template sheet to show results for any choice of account number. If you need to save/print/PDF particular combinations, e.g. if there's a management report for Person A to show all Accounts, and for Person B to show only account #PDQ, it is relatively simple to write VBA loops to produce separate files/PDFs.

Book3
ABCDE
1
2
3Account #Field 1Field 2
4PDQ513
5
Template
Cell Formulas
RangeFormula
C4C4=INDEX(Sheet1!D:D,MATCH(Template!B4,Sheet1!C:C,))
D4D4=INDEX(Sheet2!B:B,MATCH(Template!B4,Sheet2!A:A,))

Book3
ABCDE
1
2
3
4Account #Some No
5ABC2
6DEF3
7PDQ5
8
Sheet1

Book3
ABC
1
2
3
4
5
6
7Account #Some No
8ABC7
9DEF11
10PDQ13
11
Sheet2


BTW, your code could be shortened considerably by removing all the .Select's e.g.

VBA Code:
Range("A1").Value = "LedgerSheet - Account #:"
'rather than
Range("A1").Select
ActiveCell.FormulaR1C1 = "LedgerSheet - Account #:"
 
Upvote 0

Forum statistics

Threads
1,214,926
Messages
6,122,305
Members
449,079
Latest member
juggernaut24

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