What is that picture supposed to be showing?
Printable View
What is that picture supposed to be showing?
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?
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.
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..
Attachment 26527
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.
Code: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
This is much quicker
Code: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
works perfectly :bow::bow::bow::bow::bow:
thank you so much for being so patient with me. :clap:
Wait I just noticed... The others are not being colored, they remain black
Attachment 26542
I've fixed it :)
Attachment 26543
thank you, xld :bow::clap:
What was the problem/fix? Was it no value in the Weekly column?
Honestly I'm not sure. I edited the HEADSTART + 1 but when I compared it to your codes here, it's the same. So technically I didn't change anything but for some reason it didn't work the first time. Weird.Quote:
Originally Posted by xld
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.
Yes that's still showing, I just removed them in post 51 :D
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 :(Code:'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)
.Cells(nextrow, "B").Text = da...
Sam's suggestion won't work. Text is a read-only property.
This revamped code is tidier, and should address the outstanding issues.
Code: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
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:Code:'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 changedCode:'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)
toCode: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
but I got more errors after that. What do I do?Code: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 soCode:Enum 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.Code:SetValuesFormat Worksheets("Table").Cells(nextrow, "C").Resize(1, 10), database(i, colDatabase.Format)