Vincent88
Active Member
- Joined
- Mar 5, 2021
- Messages
- 382
- Office Version
- 2019
- Platform
- Windows
- Mobile
Hi Guys,
I want to change the color of font in rows of Column B if the sum amount meets the conditions. Please advise what should be corrected. Thanks in advance.
I want to change the color of font in rows of Column B if the sum amount meets the conditions. Please advise what should be corrected. Thanks in advance.
VBA Code:
Sub vSum8()
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim rngg As Range
Dim rnggRow As Range
Dim i As Range
Dim lastRow As Long
Dim lastcol As Long
Dim rnggCol As Range, rng1Row As Range
Dim vDayB As Date, vDayE As Date
Dim vColumnB As Range, vColumnE As Range
ActiveWindow.ScrollColumn = 2
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
Set rngg = Range(Cells(1, 1), Cells(lastRow, lastcol))
Set rnggCol = rngg.Columns(2).Cells(3).Resize(lastRow - 2, 1) 'Column B
For Each i In rnggCol
'Set rnggColRow = rnggCol.Cells(i.Row - 2).Resize(1, vColumnE.Column - 1)
Dim strtot As String, strlve As String, _
strday As String, streve As String, strnte As String
Dim strampm As Double
Dim myArrayd As Variant, myArrayl As Variant, myArrayampm As Variant
myArrayd = Array("D", "D1", "D2", "D3", "D4", "G")
myArrayl = Array("AL", "VL")
myArrayampm = Array("AM", "PM")
Set rng1Row = Range(Cells(1, 3), Cells(1, lastcol))
vDayB = CDate(Format(ActiveSheet.Name, "0000-00"))
vDayE = DateAdd("m", 1, vDayB) - 1
Set vColumnB = rng1Row.Find(vDayB, , xlFormulas)
Set vColumnE = rng1Row.Find(vDayE, , xlFormulas)
Dim rgLookUp As Range
Set rgLookUp = Range(i.Cells(, vColumnB.Column - 1), i.Cells(, vColumnE.Column - 1))
Dim vLastRowHo As Long
vLastRowHo = Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
HolidayList = Worksheets("Data").Range("A2:A" & vLastRowHo).Value
strtot = Application.NetworkDays(vDayB, vDayE, HolidayList)
strampm = Application.Sum(Application.CountIfs(rgLookUp, myArrayampm)) / 2
Debug.Print strampm
strlve = Application.Sum(Application.Sum(Application.CountIfs(rgLookUp, myArrayl)), strampm)
strday = Application.Sum(Application.Sum(Application.CountIfs(rgLookUp, myArrayd)), strampm)
streve = Application.CountIf(rgLookUp, "E")
strnte = Application.CountIf(rgLookUp, "N")
i = "T:" & strtot & " L:" & strlve & " D:" _
& strday & " E:" & streve & " N:" & strnte
Next i
'CONDITIONAL FORMATTING CELL B TO HIGHLIGHT FONT COLOR
Dim a As Range
Dim result As Variant
result = Application.Sum(strlve, strday, streve, strnte)
Debug.Print answer
For Each a In rnggCol.Rows
If result > strtot Then
a.Font.Color = vbRed
ElseIf result < strtot Then
a.Font.Color = vbGreen
Else: result = strtot
a.Font.Color = vbBlack
End If
Next a
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub