MeisterConrad
New Member
- Joined
- Jan 17, 2017
- Messages
- 42
- Office Version
- 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.
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"