Creating a single Table with different formulas Excel VBA

**SamT** · 04-29-2020, 10:51 AM

Sorry but is there any chance that I can still continue with my sample workbook? I

You can, but I'm not going to try to unravel that washtub of spaghetti. And you can tell your management that I said they are asking for a short road to hell.

By the way, I am going to merge AaliiyahN82's thread relating to this issue into this thread.

**Bob Phillips** · 04-29-2020, 04:33 PM

Is this any use for you?

Public Sub CategoryAnalysis()
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>!C8,Table!R6C,<period>!C4,Table!RC1)"
Dim database As Worksheet
Dim level As String
Dim nextrow As Long
Dim lastrow As Long
Dim i As Long

    
    Set database = Worksheets("Database")
    With Worksheets("Table")
    
        SetupHeadings
        nextrow = 7
        
        lastrow = database.Cells(Rows.Count, "A").End(xlUp).Row
        level = vbNullString
        For i = 2 To lastrow
        
            If database.Cells(i, "A").Value <> level Then
            
                level = database.Cells(i, "A").Value
                .Cells(nextrow, "A").Value = level
                .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Monthly")
                .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Weekly")
                .Cells(nextrow, "C").Resize(1, 10).NumberFormat = "0%"
                .Cells(nextrow, "C").Resize(1, 10).Font.Bold = True
                .Cells(nextrow, "C").Resize(1, 10).HorizontalAlignment = xlCenter
                
                nextrow = nextrow + 1
            End If
            
            .Cells(nextrow, "A").Value = database.Cells(i, "D").Value
            .Cells(nextrow, "A").Font.Italic = True
            .Cells(nextrow, "A").HorizontalAlignment = xlLeft
            .Cells(nextrow, "A").IndentLevel = 1
            .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(FORMULA_SUB_CATEGORY, "<period>", "Monthly")
            .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(FORMULA_SUB_CATEGORY, "<period>", "Weekly")
            .Cells(nextrow, "C").Resize(1, 10).HorizontalAlignment = xlCenter
            Select Case database.Cells(i, "H").Value
                
                Case "Percentage"
                    
                    .Cells(nextrow, "C").Resize(1, 10).NumberFormat = "0%"
                    
                Case "Decimal"
                
                    .Cells(nextrow, "C").Resize(1, 10).NumberFormat = "#0.000"
            End Select
            
            nextrow = nextrow + 1
        Next i
    End With
End Sub

Private Sub SetupHeadings()

    With Worksheets("Table")
    
        .Range("A5:L5").Value = Array(vbNullString, vbNullString, "MTD", "MTD -1", "WEEK 0", "WEEK -1", "WEEK -2", "WEEK -3", "WEEK -4", "WEEK -5", "WEEK -6", "WEEK -7")
        .Range("C5:D5").Interior.Color = RGB(84, 130, 53)
        .Range("E5:L5").Interior.Color = RGB(142, 169, 219)
        .Range("A5:L5").Font.Color = vbWhite
        .Range("A6:B6").Value = Array("CATEGORY", "TARGET")
        .Range("A6:D6").Interior.Color = RGB(198, 224, 180)
        .Range("E6:L6").Interior.Color = RGB(180, 198, 231)
        .Range("C6").FormulaArray = "=MAX(IF(Monthly!C12=Table!R1C2,Monthly!C8))"
        .Range("D6").FormulaR1C1 = "=EOMONTH(RC[-1],-1)"
        .Range("E6").FormulaR1C1 = "=MAX(Weekly!C8)"
        .Range("C6:L6").NumberFormat = "dd-mmm"
        .Range("F6:L6").FormulaR1C1 = "=RC[-1]-7"
        .Range("A5:L6").HorizontalAlignment = xlCenter
        .Range("A5:L6").Font.Bold = True
    End With
End Sub

**jazz2409** · 04-29-2020, 07:40 PM

Originally Posted by xld

Is this any use for you?

Public Sub CategoryAnalysis()
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>!C8,Table!R6C,<period>!C4,Table!RC1)"
Dim database As Worksheet
Dim level As String
Dim nextrow As Long
Dim lastrow As Long
Dim i As Long

    
    Set database = Worksheets("Database")
    With Worksheets("Table")
    
        SetupHeadings
        nextrow = 7
        
        lastrow = database.Cells(Rows.Count, "A").End(xlUp).Row
        level = vbNullString
        For i = 2 To lastrow
        
            If database.Cells(i, "A").Value <> level Then
            
                level = database.Cells(i, "A").Value
                .Cells(nextrow, "A").Value = level
                .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Monthly")
                .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(FORMULA_CATEGORY, "<period>", "Weekly")
                .Cells(nextrow, "C").Resize(1, 10).NumberFormat = "0%"
                .Cells(nextrow, "C").Resize(1, 10).Font.Bold = True
                .Cells(nextrow, "C").Resize(1, 10).HorizontalAlignment = xlCenter
                
                nextrow = nextrow + 1
            End If
            
            .Cells(nextrow, "A").Value = database.Cells(i, "D").Value
            .Cells(nextrow, "A").Font.Italic = True
            .Cells(nextrow, "A").HorizontalAlignment = xlLeft
            .Cells(nextrow, "A").IndentLevel = 1
            .Cells(nextrow, "C").Resize(1, 2).FormulaR1C1 = Replace(FORMULA_SUB_CATEGORY, "<period>", "Monthly")
            .Cells(nextrow, "E").Resize(1, 8).FormulaR1C1 = Replace(FORMULA_SUB_CATEGORY, "<period>", "Weekly")
            .Cells(nextrow, "C").Resize(1, 10).HorizontalAlignment = xlCenter
            Select Case database.Cells(i, "H").Value
                
                Case "Percentage"
                    
                    .Cells(nextrow, "C").Resize(1, 10).NumberFormat = "0%"
                    
                Case "Decimal"
                
                    .Cells(nextrow, "C").Resize(1, 10).NumberFormat = "#0.000"
            End Select
            
            nextrow = nextrow + 1
        Next i
    End With
End Sub

Private Sub SetupHeadings()

    With Worksheets("Table")
    
        .Range("A5:L5").Value = Array(vbNullString, vbNullString, "MTD", "MTD -1", "WEEK 0", "WEEK -1", "WEEK -2", "WEEK -3", "WEEK -4", "WEEK -5", "WEEK -6", "WEEK -7")
        .Range("C5:D5").Interior.Color = RGB(84, 130, 53)
        .Range("E5:L5").Interior.Color = RGB(142, 169, 219)
        .Range("A5:L5").Font.Color = vbWhite
        .Range("A6:B6").Value = Array("CATEGORY", "TARGET")
        .Range("A6:D6").Interior.Color = RGB(198, 224, 180)
        .Range("E6:L6").Interior.Color = RGB(180, 198, 231)
        .Range("C6").FormulaArray = "=MAX(IF(Monthly!C12=Table!R1C2,Monthly!C8))"
        .Range("D6").FormulaR1C1 = "=EOMONTH(RC[-1],-1)"
        .Range("E6").FormulaR1C1 = "=MAX(Weekly!C8)"
        .Range("C6:L6").NumberFormat = "dd-mmm"
        .Range("F6:L6").FormulaR1C1 = "=RC[-1]-7"
        .Range("A5:L6").HorizontalAlignment = xlCenter
        .Range("A5:L6").Font.Bold = True
    End With
End Sub

hello, the highlighted has to be taken into consideration for the ones that are in italics. Basically the ones that in italics already have values that are on the weekly and monthly sheets, we just need to look them up from those sheets and then put them into the table.

Capture.jpg

**jazz2409** · 04-29-2020, 07:45 PM

Originally Posted by SamT

You can, but I'm not going to try to unravel that washtub of spaghetti. And you can tell your management that I said they are asking for a short road to hell.

By the way, I am going to merge AaliiyahN82's thread relating to this issue into this thread.

Hahaha I wish I could just tell them to "gfy" without losing my job.

**SamT** · 04-29-2020, 07:52 PM

I got friends down that way

Take it home and in your own time do it the right way, Then at work just treat their workbook as a Report and use your book to fill in the blanks once a week.

Seriously, you could create the "Right way" on xlVeryHidden sheets and then fill in the blanks on their Report sheets. Report sheets do belong to those who need the Reports, It's just our job to fill in the blanks on their Reports. I don't usually even think about Reports until I have at least a rough draft of the Data Base sheets, but you might have to work bass ackwards.

**jazz2409** · 04-29-2020, 08:32 PM

Originally Posted by SamT

I got friends down that way

Take it home and in your own time do it the right way, Then at work just treat their workbook as a Report and use your book to fill in the blanks once a week.

Seriously, you could create the "Right way" on xlVeryHidden sheets and then fill in the blanks on their Report sheets. Report sheets do belong to those who need the Reports, It's just our job to fill in the blanks on their Reports. I don't usually even think about Reports until I have at least a rough draft of the Data Base sheets, but you might have to work bass ackwards.

I am taking your advice, I will follow the workbook you attached. Maybe I can show it to them and make them realize you're right

For now I just really need to once and for all solve this thing right here so I'll have something to present to them tomorrow morning.

**Bob Phillips** · 04-30-2020, 01:06 AM

Originally Posted by jazz2409

hello, the highlighted has to be taken into consideration for the ones that are in italics. Basically the ones that in italics already have values that are on the weekly and monthly sheets, we just need to look them up from those sheets and then put them into the table.

Capture.jpg

Isn't that what my code does?

**Bob Phillips** · 04-30-2020, 01:57 AM

What I mean is that Category 1a, Category 1b are subs of Category 1, so by testing the sub-category you are automatically testing the category. No need to include both.

**jazz2409** · 04-30-2020, 03:12 AM

Originally Posted by xld

What I mean is that Category 1a, Category 1b are subs of Category 1, so by testing the sub-category you are automatically testing the category. No need to include both.

Hello, yes it actually does do that.. It's just that I forgot to mention that some sub categories repeat for other main categories...

**Bob Phillips** · 04-30-2020, 03:38 AM

Easily added in.

Public Sub CategoryAnalysis()
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 nextrow As Long, lastrow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set database = Worksheets("Database")
    With Worksheets("Table")
    
        SetupHeadings
        nextrow = 7
        
        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)
            
            
            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
            
            nextrow = nextrow + 1
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

Private Sub SetupHeadings()

    With Worksheets("Table")
    
        .Range("A5:L5").Value = Array(vbNullString, vbNullString, "MTD", "MTD -1", "WEEK 0", "WEEK -1", "WEEK -2", "WEEK -3", "WEEK -4", "WEEK -5", "WEEK -6", "WEEK -7")
        .Range("C5:D5").Interior.Color = RGB(84, 130, 53)
        .Range("E5:L5").Interior.Color = RGB(142, 169, 219)
        .Range("A5:L5").Font.Color = vbWhite
        .Range("A6:B6").Value = Array("CATEGORY", "TARGET")
        .Range("A6:D6").Interior.Color = RGB(198, 224, 180)
        .Range("E6:L6").Interior.Color = RGB(180, 198, 231)
        .Range("C6").FormulaArray = "=MAX(IF(Monthly!C12=Table!R1C2,Monthly!C8))"
        .Range("D6").FormulaR1C1 = "=EOMONTH(RC[-1],-1)"
        .Range("E6").FormulaR1C1 = "=MAX(Weekly!C8)"
        .Range("C6:L6").NumberFormat = "dd-mmm"
        .Range("F6:L6").FormulaR1C1 = "=RC[-1]-7"
        .Range("A5:L6").HorizontalAlignment = xlCenter
        .Range("A5:L6").Font.Bold = True
    End With
End Sub

**jazz2409** · 04-30-2020, 04:19 AM

THANK YOU SO MUCH!

We'll have something to present in our zoom meeting later because of all of you here

**jazz2409** · 04-30-2020, 04:20 AM

I can't tag the thread as solved... Why?

**Bob Phillips** · 04-30-2020, 04:43 AM

It is in the Thread Tools link towards the top of the page. I have done it for you this time.

**jazz2409** · 04-30-2020, 08:51 AM

Originally Posted by xld

It is in the Thread Tools link towards the top of the page. I have done it for you this time.

Hello, Sorry how do I add this line:

          With .Cells(nextrow, "G").Resize(1, 8)
                Select Case Worksheets("Weekly").Cells(i, "L").Value
                    
                    Case "P":  .Font.Color = vbGreen
                    Case "F":  .Font.Color = vbRed
                End Select
                .Font.Size = 8
                .Font.Bold = False
                .HorizontalAlignment = xlCenter
          End With

It's for if the sub category says P on the weekly (for the weekly cells of sub categories)/monthly (for the monthly cells of sub categories)sheets, the numbers will be color green. And then if it's F, the numbers will be red. Just for sub categories.

I tried adding it at the end after the select case statement for decimal/percentage. It worked while it was running but once it was done it went back to being black

**Bob Phillips** · 04-30-2020, 09:03 AM

Why Weekly sheet? Why column G? Why 8 columns?

**jazz2409** · 04-30-2020, 09:11 AM

Originally Posted by xld

Why Weekly sheet? Why column G? Why 8 columns?

I was thinking I'll have a different set of select case statements for weekly and monthly sheets

Sorry it's supposedly column E. Based on the table the weekly numbers will be from E:L - that's why it's 8, as to what I understood it's resize to 8 columns?
And then the one for monthly will be columns C : D and then resize(1,2)?

**Bob Phillips** · 04-30-2020, 09:34 AM

Column E makes more sense. Not sure which column in Monthly, I left it at L, you might need to change.

Public Sub CategoryAnalysis()
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 nextrow As Long, lastrow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set database = Worksheets("Database")
    With Worksheets("Table")
    
        SetupHeadings
        nextrow = 7
        
        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)
            
            With .Cells(nextrow, "C").Resize(1, 2)
            
                Select Case Worksheets("Monthly").Cells(i, "L").Value
                    
                    Case "P":   .Font.Color = vbGreen
                    Case "F":   .Font.Color = vbRed
                End Select
            End With
            
            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
            
            With .Cells(nextrow, "E").Resize(1, 8)
            
                Select Case Worksheets("Weekly").Cells(i, "L").Value
                    
                    Case "P":   .Font.Color = vbGreen
                    Case "F":   .Font.Color = vbRed
                End Select
            End With
            
            nextrow = nextrow + 1
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

**jazz2409** · 04-30-2020, 10:18 AM

Didn't work... Well yes it did work but not quite. It only colors the entire row and nor per item

**Bob Phillips** · 04-30-2020, 10:47 AM

Ah yes, it is looking at Weekly and Monthly with the database row.

See if this works.

Public Sub CategoryAnalysis()
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

    Application.ScreenUpdating = False
    
    Set database = Worksheets("Database")
    With Worksheets("Table")
    
        SetupHeadings
        nextrow = 7
        
        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)
            
            With .Cells(nextrow, "C").Resize(1, 2)
            
                monthlyrow = MatchRow("Monthly", level, database.Cells(i, "D").Value)
                If monthlyrow > 0 Then
                
                    Select Case Worksheets("Monthly").Cells(monthloyrow, "L").Value
                        
                        Case "P":   .Font.Color = vbGreen
                        Case "F":   .Font.Color = vbRed
                    End Select
                End If
            End With
            
            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
            
            With .Cells(nextrow, "E").Resize(1, 8)
            
                weeklyrow = MatchRow("Weekly", level, database.Cells(i, "D").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
            
            nextrow = nextrow + 1
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

Private Sub SetupHeadings()

    With Worksheets("Table")
    
        .Range("A5:L5").Value = Array(vbNullString, vbNullString, "MTD", "MTD -1", "WEEK 0", "WEEK -1", "WEEK -2", "WEEK -3", "WEEK -4", "WEEK -5", "WEEK -6", "WEEK -7")
        .Range("C5:D5").Interior.Color = RGB(84, 130, 53)
        .Range("E5:L5").Interior.Color = RGB(142, 169, 219)
        .Range("A5:L5").Font.Color = vbWhite
        .Range("A6:B6").Value = Array("CATEGORY", "TARGET")
        .Range("A6:D6").Interior.Color = RGB(198, 224, 180)
        .Range("E6:L6").Interior.Color = RGB(180, 198, 231)
        .Range("C6").FormulaArray = "=MAX(IF(Monthly!C12=Table!R1C2,Monthly!C8))"
        .Range("D6").FormulaR1C1 = "=EOMONTH(RC[-1],-1)"
        .Range("E6").FormulaR1C1 = "=MAX(Weekly!C8)"
        .Range("C6:L6").NumberFormat = "dd-mmm"
        .Range("F6:L6").FormulaR1C1 = "=RC[-1]-7"
        .Range("A5:L6").HorizontalAlignment = xlCenter
        .Range("A5:L6").Font.Bold = True
    End With
End Sub

Private Function MatchRow(ByRef sh As String, ByVal cat As String, ByVal subcat As String) As Long

    On Error Resume Next
    MatchRow = Application.Evaluate("Match(1, ('" & sh & "'!A:A=""" & cat & """)*('" & sh & "'!D:D=""" & subcat & """),0)")
End Function

**jazz2409** · 04-30-2020, 08:22 PM

Still the samea.jpg

Thread: Creating a single Table with different formulas Excel VBA

Thread Tools

Display

Tags for this Thread

Posting Permissions