What is that picture supposed to be showing?
What is that picture supposed to be showing?
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
I mean for weeks 3/2/2020, 3/23/2020, and 4/13/2020 category 1a is F but on the table they're still color green
Ah, you never said you wanted it to be week specific as well, you just mentioned P or F on sub-category, and your example showed applying the same test to all 8 columns, which you plainly cannot do if you are checking the date as well. Weekly might be doable, but what about Monthly? First the vcolumn L already has a value in it, month, and the dates are some MTD, so what date should be checked against?
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
Hello, can it be like while getting the data for weekly/monthly the value on column L will be checked as well so it wi be colored based on what's in column L? Sorry I'm not really good at explaining things
Clearly not. As I said, weekly is simple because the dates in column H are the same dates as we setup on the analysis sheet. Monthly is harder, as column L holds a month value not a P or F, and the date is some date in the month, whereas the analysis is month end date.
This will slow the code down considerably with all the extra looping.
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
Hmmm on my monthly sheet, I will only have two dates.. Those dates will be the same as what's on the analysis sheet.. And my column L in monthly sheet is the P/F column.. So if the EOMONTH column isn't available on the Monthly Sheet, the color will just be black..
a.jpg
You've changed the layout of the Monthly sheet, you added another column before the previous column L. If I was working with you and you did that without telling me I would not be very impressed.
As I said, it is much slower, even on this small set of data.
Public Sub CategoryAnalysis() Const MSG_TITLE As String = "Category Analysis" Const HEAD_START As Long = 5 Const FORMULA_CATEGORY As String = _ "=IFERROR(COUNTIFS(<period>!C10,""P"",<period>!C8,Table!R6C,<period>!C1,Table!RC1)" & _ "/SUMIFS(<period>!C11,<period>!C8,Table!R6C,<period>!C1,Table!RC1),""-"")" Const FORMULA_SUB_CATEGORY As String = _ "=SUMIFS(<period>!C9,<period>!C1,""<level>"",<period>!C8,Table!R6C,<period>!C4,Table!RC1)" Dim database As Worksheet Dim level As String Dim weeklyrow As Long, monthlyrow As Long Dim nextrow As Long, lastrow As Long Dim i As Long, ii As Long On Error GoTo cat_error Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set database = Worksheets("Database") With Worksheets("Table") SetupHeadings HEAD_START nextrow = HEAD_START + 2 lastrow = database.Cells(Rows.Count, "A").End(xlUp).Row level = vbNullString For i = 2 To lastrow 'setup category row text, formulas and formats If database.Cells(i, "A").Value <> level Then level = database.Cells(i, "A").Value With .Cells(nextrow, "A") .Value = level .Font.Italic = False .HorizontalAlignment = xlLeft .IndentLevel = 0 End With .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Monthly") .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Weekly") With .Cells(nextrow, "C").Resize(1, 10) .NumberFormat = "0%" .Font.Size = 10 .Font.Bold = True .HorizontalAlignment = xlCenter End With nextrow = nextrow + 1 End If 'setup sub-category row text, formulas and formats With .Cells(nextrow, "A") .Value = database.Cells(i, "D").Value .Font.Italic = True .HorizontalAlignment = xlLeft .IndentLevel = 1 End With .Cells(nextrow, "B").Value = database.Cells(i, "F").Text .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(Replace(FORMULA_SUB_CATEGORY, "<period>", "Monthly"), "<level>", level) .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(Replace(FORMULA_SUB_CATEGORY, "<period>", "Weekly"), "<level>", level) For ii = 3 To 4 With .Cells(nextrow, ii) monthlyrow = MatchRow("Monthly", level, database.Cells(i, "D").Value, Worksheets("Table").Cells(HEAD_START + 1, ii).Value) If monthlyrow > 0 Then Select Case Worksheets("Monthly").Cells(monthlyrow, "L").Value Case "P": .Font.Color = vbGreen Case "F": .Font.Color = vbRed End Select End If End With Next ii With .Cells(nextrow, "C").Resize(1, 10) Select Case database.Cells(i, "H").Value Case "Percentage": .NumberFormat = "0%" Case "Decimal": .NumberFormat = "#0.000" End Select .Font.Size = 8 .Font.Bold = False .HorizontalAlignment = xlCenter End With For ii = 5 To 12 With .Cells(nextrow, ii) weeklyrow = MatchRow("Weekly", level, database.Cells(i, "D").Value, Worksheets("Table").Cells(HEAD_START + 1, ii).Value) If weeklyrow > 0 Then Select Case Worksheets("Weekly").Cells(weeklyrow, "L").Value Case "P": .Font.Color = vbGreen Case "F": .Font.Color = vbRed End Select End If End With Next ii nextrow = nextrow + 1 Next i End With MsgBox "All done", vbOKOnly + vbInformation, MSG_TITLE cat_exit: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Exit Sub cat_error: MsgBox "Something went wrong" & vbNewLine & _ " error number: " & Err.Number & vbNewLine & _ " error description: " & Err.Description, vbOKOnly + vbCritical, MSG_TITLE End Sub Private Sub SetupHeadings(ByVal loc As Long) With Worksheets("Table").Cells(loc, "A") .Range("A1:L1").Value = Array(vbNullString, vbNullString, "MTD", "MTD -1", "WEEK 0", "WEEK -1", "WEEK -2", "WEEK -3", "WEEK -4", "WEEK -5", "WEEK -6", "WEEK -7") .Range("C1:D1").Interior.Color = RGB(84, 130, 53) .Range("E1:L1").Interior.Color = RGB(142, 169, 219) .Range("A1:L1").Font.Color = vbWhite .Range("A2:B2").Value = Array("CATEGORY", "TARGET") .Range("A2:D2").Interior.Color = RGB(198, 224, 180) .Range("E2:L2").Interior.Color = RGB(180, 198, 231) .Range("C2").FormulaArray = "=MAX(IF(Monthly!C13=Table!R1C2,Monthly!C8))" .Range("D2").FormulaR1C1 = "=EOMONTH(RC[-1],-1)" .Range("E2").FormulaR1C1 = "=MAX(Weekly!C8)" .Range("C2:L2").NumberFormat = "dd-mmm" .Range("F2:L2").FormulaR1C1 = "=RC[-1]-7" .Range("A1:L2").HorizontalAlignment = xlCenter .Range("A1:L2").Font.Bold = True End With End Sub Private Function MatchRow(ByRef sh As String, ByVal cat As String, ByVal subcat As String, ByVal week As Date) As Long On Error Resume Next MatchRow = Application.Evaluate("Match(1, ('" & sh & "'!A:A=""" & cat & """)*('" & sh & "'!D:D=""" & subcat & """)*('" & sh & "'!H:H=" & CLng(week) & "),0)") End Function
Last edited by Bob Phillips; 05-01-2020 at 07:22 AM.
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
This is much quicker
Public Sub CategoryAnalysis() Const MSG_TITLE As String = "Category Analysis" Const HEAD_START As Long = 5 Const FORMULA_CATEGORY As String = _ "=IFERROR(COUNTIFS(<period>!C10,""P"",<period>!C8,Table!R6C,<period>!C1,Table!RC1)" & _ "/SUMIFS(<period>!C11,<period>!C8,Table!R6C,<period>!C1,Table!RC1),""-"")" Const FORMULA_SUB_CATEGORY As String = _ "=SUMIFS(<period>!C9,<period>!C1,""<level>"",<period>!C8,Table!R6C,<period>!C4,Table!RC1)" Dim database As Variant Dim level As String Dim weeklyrow As Long, monthlyrow As Long Dim nextrow As Long, lastrow As Long Dim i As Long, ii As Long Dim starttime As Double On Error GoTo cat_error starttime = Timer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With Worksheets("Weekly") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("N2").Resize(lastrow - 1).Formula = "=A2&D2&INT(H2)" End With With Worksheets("Monthly") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("N2").Resize(lastrow - 1).Formula = "=A2&D2&INT(H2)" End With database = Worksheets("Database").UsedRange With Worksheets("Table") SetupHeadings HEAD_START nextrow = HEAD_START + 2 level = vbNullString For i = LBound(database, 1) + 1 To UBound(database, 1) 'setup category row text, formulas and formats If database(i, 1) <> level Then level = database(i, 1) With .Cells(nextrow, "A") .Value = level .Font.Italic = False .HorizontalAlignment = xlLeft .IndentLevel = 0 End With .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Monthly") .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Weekly") With .Cells(nextrow, "C").Resize(1, 10) .NumberFormat = "0%" .Font.Size = 10 .Font.Bold = True .HorizontalAlignment = xlCenter End With nextrow = nextrow + 1 End If 'setup sub-category row text, formulas and formats With .Cells(nextrow, "A") .Value = database(i, 4) .Font.Italic = True .HorizontalAlignment = xlLeft .IndentLevel = 1 End With .Cells(nextrow, "B").Value = database(i, 6) .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(Replace(FORMULA_SUB_CATEGORY, "<period>", "Monthly"), "<level>", level) .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(Replace(FORMULA_SUB_CATEGORY, "<period>", "Weekly"), "<level>", level) For ii = 3 To 4 With .Cells(nextrow, ii) ' monthlyrow = MatchRow("Monthly", level, database(i, 4), Worksheets("Table").Cells(HEAD_START + 1, ii).Value) monthlyrow = MatchIt("Monthly", level & database(i, 4) & CLng(Worksheets("Table").Cells(HEAD_START + 1, ii).Value)) If monthlyrow > 0 Then Select Case Worksheets("Monthly").Cells(monthlyrow, "L").Value Case "P": .Font.Color = vbGreen Case "F": .Font.Color = vbRed End Select End If End With Next ii With .Cells(nextrow, "C").Resize(1, 10) Select Case database(i, 8) Case "Percentage": .NumberFormat = "0%" Case "Decimal": .NumberFormat = "#0.000" End Select .Font.Size = 8 .Font.Bold = False .HorizontalAlignment = xlCenter End With For ii = 5 To 12 With .Cells(nextrow, ii) ' weeklyrow = MatchRow("Weekly", level, database(i, 4), Worksheets("Table").Cells(HEAD_START + 1, ii).Value) weeklyrow = MatchIt("Weekly", level & database(i, 4) & CLng(Worksheets("Table").Cells(HEAD_START + 1, ii).Value)) If weeklyrow > 0 Then Select Case Worksheets("Weekly").Cells(weeklyrow, "L").Value Case "P": .Font.Color = vbGreen Case "F": .Font.Color = vbRed End Select End If End With Next ii Debug.Print nextrow nextrow = nextrow + 1 Next i End With Worksheets("Weekly").Columns("N").Delete Worksheets("Monthly").Columns("N").Delete Debug.Print "Elapsed time: " & Timer - starttime MsgBox "All done", vbOKOnly + vbInformation, MSG_TITLE cat_exit: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Exit Sub cat_error: MsgBox "Something went wrong" & vbNewLine & _ " error number: " & Err.Number & vbNewLine & _ " error description: " & Err.Description, vbOKOnly + vbCritical, MSG_TITLE End Sub Private Sub SetupHeadings(ByVal loc As Long) With Worksheets("Table").Cells(loc, "A") .Range("A1:L1").Value = Array(vbNullString, vbNullString, "MTD", "MTD -1", "WEEK 0", "WEEK -1", "WEEK -2", "WEEK -3", "WEEK -4", "WEEK -5", "WEEK -6", "WEEK -7") .Range("C1:D1").Interior.Color = RGB(84, 130, 53) .Range("E1:L1").Interior.Color = RGB(142, 169, 219) .Range("A1:L1").Font.Color = vbWhite .Range("A2:B2").Value = Array("CATEGORY", "TARGET") .Range("A2:D2").Interior.Color = RGB(198, 224, 180) .Range("E2:L2").Interior.Color = RGB(180, 198, 231) .Range("C2").FormulaArray = "=MAX(IF(Monthly!C13=Table!R1C2,Monthly!C8))" .Range("D2").FormulaR1C1 = "=EOMONTH(RC[-1],-1)" .Range("E2").FormulaR1C1 = "=MAX(Weekly!C8)" .Range("C2:L2").NumberFormat = "dd-mmm" .Range("F2:L2").FormulaR1C1 = "=RC[-1]-7" .Range("A1:L2").HorizontalAlignment = xlCenter .Range("A1:L2").Font.Bold = True End With End Sub Private Function MatchRow(ByRef sh As String, ByVal cat As String, ByVal subcat As String, ByVal week As Date) As Long On Error Resume Next MatchRow = Application.Evaluate("Match(1, ('" & sh & "'!A:A=""" & cat & """)*('" & sh & "'!D:D=""" & subcat & """)*('" & sh & "'!H:H=" & CLng(week) & "),0)") End Function Private Function MatchIt(ByRef sh As String, ByVal lookupval) As Long On Error Resume Next MatchIt = Application.Match(lookupval, Worksheets(sh).Columns(14), 0) End Function
Last edited by Bob Phillips; 05-01-2020 at 07:22 AM.
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
works perfectly
thank you so much for being so patient with me.
Last edited by Bob Phillips; 05-02-2020 at 05:31 AM. Reason: Removed unnecessary quote
Wait I just noticed... The others are not being colored, they remain black
a.jpg
What was the problem/fix? Was it no value in the Weekly column?
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
I also noticed that in your pic in post #50, there seems to be two extra lines. Are you still getting that, as I saw that here at some point and know the cause and how to fix it.
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
Yes that's still showing, I just removed them in post 51
Also in this part:
What can be done in order to just copy and paste everything in database.Cells(i,"F") as they are? The percentages are changing to decimals'setup sub-category row text, formulas and formats With .Cells(nextrow, "A") .Value = database.Cells(i, "D").Value .Font.Italic = True .HorizontalAlignment = xlLeft .IndentLevel = 1 End With .Cells(nextrow, "B").Value = database.Cells(i, "F").Text .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(Replace(FORMULA_SUB_CATEGORY, "<period>", "Monthly"), "<level>", level) .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(Replace(FORMULA_SUB_CATEGORY, "<period>", "Weekly"), "<level>", level)
Last edited by jazz2409; 05-02-2020 at 11:53 PM.
.Cells(nextrow, "B").Text = da...
I expect the student to do their homework and find all the errrors I leeve in.
Please take the time to read the Forum FAQ
Sam's suggestion won't work. Text is a read-only property.
This revamped code is tidier, and should address the outstanding issues.
Const MSG_TITLE As String = "Category Analysis" Const HEAD_START As Long = 5 Const FORMULA_CATEGORY As String = _ "=IFERROR(COUNTIFS(<period>!C10,""P"",<period>!C8,Table!R6C,<period>!C1,Table!RC1)" & _ "/SUMIFS(<period>!C11,<period>!C8,Table!R6C,<period>!C1,Table!RC1),""-"")" Const FORMULA_SUB_CATEGORY As String = _ "=SUMIFS(<period>!C9,<period>!C1,""<level>"",<period>!C8,Table!R6C,<period>!C4,Table!RC1)" Public Sub CategoryAnalysis() Dim database As Variant Dim category As String Dim weeklyrow As Long, monthlyrow As Long Dim numItems As Long, items As Variant Dim nextrow As Long, lastrow As Long Dim i As Long, ii As Long Dim starttime As Double On Error GoTo cat_error starttime = Timer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With Worksheets("Weekly") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("N2").Resize(lastrow - 1).Formula = "=A2&D2&INT(H2)" End With With Worksheets("Monthly") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("N2").Resize(lastrow - 1).Formula = "=A2&D2&INT(H2)" End With With Worksheets("Database") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("N2").Resize(lastrow - 1).Formula = "=A2&D2" database = .Range("A2").Resize(lastrow - 1, 8) End With With Worksheets("Table") SetupHeadings HEAD_START nextrow = HEAD_START + 2 category = vbNullString For i = LBound(database, 1) To UBound(database, 1) 'setup category row text, formulas and formats If database(i, 1) <> category Then category = database(i, 1) SetupCategoryRow nextrow, category nextrow = nextrow + 1 End If 'now setup a sub-category row SetupSubcategoryRow nextrow, category, database(i, 4) SetValuesColour Worksheets("Monthly"), nextrow, 3, 4, category, database(i, 4) SetValuesFormat Worksheets("Table").Cells(nextrow, "C").Resize(1, 10), database(i, 8) SetValuesColour Worksheets("Weekly"), nextrow, 5, 12, category, database(i, 4) nextrow = nextrow + 1 Next i End With Worksheets("Weekly").Columns("N").Delete Worksheets("Monthly").Columns("N").Delete Worksheets("Database").Columns("N").Delete cat_exit: Range("A6").Select Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True MsgBox "All done", vbOKOnly + vbInformation, MSG_TITLE Debug.Print "Elapsed time: " & Timer - starttime Exit Sub cat_error: MsgBox "Something went wrong" & vbNewLine & _ " error number: " & Err.Number & vbNewLine & _ " error description: " & Err.Description, vbOKOnly + vbCritical, MSG_TITLE End Sub Private Function SetupHeadings(ByVal loc As Long) As Boolean With Worksheets("Table").Cells(loc, "A") .Range("A1:L1").Value = Array(vbNullString, vbNullString, "MTD", "MTD -1", _ "WEEK 0", "WEEK -1", "WEEK -2", "WEEK -3", "WEEK -4", "WEEK -5", "WEEK -6", "WEEK -7") .Range("C1:D1").Interior.Color = RGB(84, 130, 53) .Range("E1:L1").Interior.Color = RGB(142, 169, 219) .Range("A1:L1").Font.Color = vbWhite .Range("A2:B2").Value = Array("CATEGORY", "TARGET") .Range("A2:D2").Interior.Color = RGB(198, 224, 180) .Range("E2:L2").Interior.Color = RGB(180, 198, 231) .Range("C2").FormulaArray = "=MAX(IF(Monthly!C13=Table!R1C2,Monthly!C8))" .Range("D2").FormulaR1C1 = "=EOMONTH(RC[-1],-1)" .Range("E2").FormulaR1C1 = "=MAX(Weekly!C8)" .Range("C2:L2").NumberFormat = "dd-mmm" .Range("F2:L2").FormulaR1C1 = "=RC[-1]-7" .Range("A1:L2").HorizontalAlignment = xlCenter .Range("A1:L2").Font.Bold = True End With End Function Public Function SetupCategoryRow(ByVal TargetRow As Long, ByVal category As Variant) As Boolean With Worksheets("Table") With .Cells(TargetRow, "A") .Value = category .Font.Italic = False .HorizontalAlignment = xlLeft .IndentLevel = 0 End With .Cells(TargetRow, "C").Resize(1, 2).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Monthly") .Cells(TargetRow, "E").Resize(1, 8).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Weekly") With .Cells(TargetRow, "C").Resize(1, 10) .NumberFormat = "0%" .Font.ColorIndex = xlColorIndexAutomatic .Font.Size = 10 .Font.Bold = True .HorizontalAlignment = xlCenter End With End With End Function Public Function SetupSubcategoryRow(ByVal TargetRow As Long, ByVal category As Variant, ByVal Subcategory As Variant) As Boolean Dim matchidx As Long With Worksheets("Table") With .Cells(TargetRow, "A") .Value = Subcategory .Font.Italic = True .HorizontalAlignment = xlLeft .IndentLevel = 1 End With matchidx = MatchIt(category & Subcategory, Worksheets("Database").Columns(14)) If matchidx > 0 Then .Cells(TargetRow, "B").Value = Worksheets("Database").Cells(matchidx, "F").Text .Cells(TargetRow, "B").NumberFormat = Worksheets("Database").Cells(matchidx, "F").NumberFormat End If .Cells(TargetRow, "C").Resize(1, 2).FormulaR1C1 = Replace(Replace(FORMULA_SUB_CATEGORY, "<period>", "Monthly"), "<level>", category) .Cells(TargetRow, "E").Resize(1, 8).FormulaR1C1 = Replace(Replace(FORMULA_SUB_CATEGORY, "<period>", "Weekly"), "<level>", category) End With End Function Private Function SetValuesColour(ByRef sh As Worksheet, ByVal TargetRow As Long, ByVal StartCol As Long, EndCol As Long, _ ByVal category As String, Subcategory As Variant) As Boolean Dim matchRow As Long Dim i As Long With Worksheets("Table") For i = StartCol To EndCol matchRow = MatchIt(category & Subcategory & CLng(.Cells(HEAD_START + 1, i).Value), sh.Columns(14)) If matchRow > 0 Then Select Case sh.Cells(matchRow, "L").Value Case "P": .Cells(TargetRow, i).Font.Color = vbGreen Case "F": .Cells(TargetRow, i).Font.Color = vbRed End Select End If Next i End With End Function Private Function SetValuesFormat(ByRef Target As Range, ByVal FormatValue As Variant) As Boolean With Target Select Case FormatValue Case "Percentage": .NumberFormat = "0%" Case "Decimal": .NumberFormat = "#0.000" End Select .Font.Size = 8 .Font.Bold = False .HorizontalAlignment = xlCenter End With End Function Private Function MatchIt(ByVal lookupval, ByVal LookupIn As Range) As Long On Error Resume Next MatchIt = Application.Match(lookupval, LookupIn, 0) End Function
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
Let me try
I have a question, though.
My Format column in Database has been moved to column J because they added a new column in before Format column. I tried changing it to:'now setup a sub-category row SetupSubcategoryRow nextrow, category, database(i, 4) SetValuesColour Worksheets("Monthly"), nextrow, 3, 4, category, database(i, 4) SetValuesFormat Worksheets("Table").Cells(nextrow, "C").Resize(1, 10), database(i, 8) SetValuesColour Worksheets("Weekly"), nextrow, 5, 12, category, database(i, 4)
but I got an error saying Subscript out of range so I changed'now setup a sub-category row SetupSubcategoryRow nextrow, category, database(i, 4) SetValuesColour Worksheets("Monthly"), nextrow, 3, 4, category, database(i, 4) SetValuesFormat Worksheets("Table").Cells(nextrow, "C").Resize(1, 10), database(i, 10) SetValuesColour Worksheets("Weekly"), nextrow, 5, 12, category, database(i, 4)
toWith Worksheets("Database") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("N2").Resize(lastrow - 1).Formula = "=A2&D2" database = .Range("A2").Resize(lastrow - 1, 8) End With
but I got more errors after that. What do I do?With Worksheets("Database") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("N2").Resize(lastrow - 1).Formula = "=A2&D2" database = .Range("A2").Resize(lastrow - 1, 10) End With
Why did you change it to database (i, 10) instead of database (I, 9) if you only added one column?
What I tend to do in my work is to create a column enum, and reference columns numbers by the enum entry, then if I add a column I just add an item to the enum.
Something like this
and then I would refence database like soEnum colDatabase Category = 1 X1 X2 Subcategory X3 Target X4 Format End Enum
and then in your case you would just add a line X5 or some such before Format and no need to change any of the coding statements.SetValuesFormat Worksheets("Table").Cells(nextrow, "C").Resize(1, 10), database(i, colDatabase.Format)
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber