VBA for color coding a cell based on values in other cells

[kalyanr12]

Experts,

I have attached a sample Excel sheet. I need some help in writing macro to set color coding the column H (VSCS pre-TT Signoff column) based on the values of column I for a group (column A).

a) Basically in the attached examples (2 excel files, one is the file containing raw data and in the other one I specified how I want the color coding to be done), for ABS group starting at A7, all I need is to get all the cell values from I8 until there is a change in group in column (in the example ABS), so I would get I8, I9 and I10 and accordingly set the cell value H7 with proper color. I have mentioned the rules below for color coding.
b) For groups like AAM, ACM, DCDC, FCDIM, PAM, PDM, TRCM, VDM there are no child rows having Release status values so for those it is straight forward and we should set the color as RED in the cells H6, H11, H16, H21, H26, H27, H32 and H33 respectively.

Rules for setting color coding:

a) If the child rows for a group have at least one of the release statuses as Draft or INCOMPLETE or Rejected, then the color code in the column H for that group should be RED
b) If there is only child row with release status as Definition Approved or Waiting for Netcom Approval or Pending Approval then color code should be yellow
c) If there is only one status row with Frozen or Vehicle Configuration Complete, then color code is green
d) If there is only one status row with Draft or Incomplete or Rejected, then color code is red
e) If there are more than one rows with Frozen, Vehicle Configuration Complete and (Definition Approved or Waiting for Netcom Approval or Pending Approval), then color is yellow
f) If there are more than one rows with Frozen or Vehicle Configuration Complete combination only, then color is Green.
g) If there are no child rows, then just set the color as RED in the column H

Lastly, I need to group all rows belonging to a value in column A. Basically for ABS group, ABS0, ABS1, ABS1 are child rows, so I want main row to show up with the "+" sign by default. If needed users can click this plus button and expand to the child rows. I want this grouping to be for every group.

Appreciate if anyone can help me with the VBA script for the same.

[mdmackillop]

I'm sure I'm not understanding e & f so this shows colours and rules applied for testing purposes. As to the last part, please provide an example of how + signs should appear.

Both your attachments are the same file. Please give multiple attached files meaningful names


Sub Test()
Dim r As Range
Dim Sht As Worksheet
Dim cel As Range
Set Sht = Sheets("Sheet1")
Sht.Columns(8).Interior.ColorIndex = xlNone
Sht.Columns(8).ClearContents
Set r = Range(Sht.Cells(6, 1), Sht.Cells(Rows.Count, 1).End(xlUp)).SpecialCells(2)
For Each cel In r
Select Case cel.Value
Case "AAM", "ACM", "DCDC", "FCDIM", "PAM", "PDM", "TRCM", "VDM"
cel.Offset(, 7).Interior.ColorIndex = 3
cel.Offset(, 7).Value = "Basic"
Case Else
If cel(2) = "" Then
Set rng = Range(cel(2), cel(2).End(xlDown)(0))
If rng.Cells.Count = 1 Then
rng.Offset(, 7).Interior.ColorIndex = Split(CheckStatus1(rng), "/")(0)
rng.Offset(, 7).Value = Split(CheckStatus1(rng), "/")(1)
Else
rng.Offset(, 7).Interior.ColorIndex = Split(CheckStatus2(rng), "/")(0)
rng.Offset(, 7).Value = Split(CheckStatus2(rng), "/")(1)
End If
End If
End Select
Next cel
End Sub


Function CheckStatus1(rng)
Dim arr, a, x
CheckStatus = False
rng.Select
'b)
arr = Array("Definition Approved", "Waiting for Netcom Approval", "Pending Approval")
For Each a In arr
If Not rng.Offset(, 8).Find(a, MatchCase:=False) Is Nothing Then
CheckStatus1 = "6/b" 'Yellow
End If
Next a
'c)
arr = Array("Frozen", "Vehicle Configuration Complete")
For Each a In arr
If Not rng.Offset(, 8).Find(a, MatchCase:=False) Is Nothing Then
CheckStatus1 = "4/c" 'Green
End If
Next a
'd)
arr = Array("Draft", "Incomplete", "Rejected")
For Each a In arr
If Not rng.Offset(, 8).Find(a, MatchCase:=False) Is Nothing Then
CheckStatus1 = "3/d" 'Red
End If
Next a
End Function


Function CheckStatus2(rng)
Dim arr, a, x
CheckStatus = False
'a)
arr = Array("Draft", "Incomplete", "Rejected")
For Each a In arr
If Not rng.Offset(, 8).Find(a, MatchCase:=False) Is Nothing Then
CheckStatus2 = "3/a" 'Red
End If
Next a
'e)
arr = Array("Frozen", "Vehicle Configuration Complete", "Definition Approved", _
"Waiting for Netcom Approval", "Pending Approval")
For Each a In arr
If Not rng.Offset(, 8).Find(a, MatchCase:=False) Is Nothing Then
CheckStatus2 = "6/e" 'Yellow
End If
Next a
'f
arr = Array("Frozen", "Vehicle Configuration Complete")
For Each a In arr
If Not rng.Offset(, 8).Find(a, MatchCase:=False) Is Nothing Then
CheckStatus2 = "4/f" 'Green
End If
Next a
End Function

[snb]

. I don't believe you are from Michigan (US)
. I think you are India based

- I don't think this is your first alias in this forum

- You have an assignment paid for by Siemens
. you suggested Siemens that you are proficient in VBA although you haven't written a single line of code
. and now you try to get a solution for free, made by volunteers in this forum to sell to Siemens

Am I right ?