CODEWITHSUNDEEP
vbaexcelcolors
dashton
dashton

Reputation: 43

Excel 2010 VBA With Setting Cell Colors

I am trying to automate a highlighting process to show that certain rows are complete. This process works well, however at the beginning of my sheet I am trying to make the code create a "Key" for the sheet to show the different meanings of the colors. In the key, the colors White, Green, and Red are used as labels for being Not yet completed (White), completed (green) and Error/Incomplete (Red). Grey is also used for private pipes. I am trying to color the corresponding labels with their color, green as green, red as red, etc. I have made code for this that works for the first line, but on green it does not color the "Green" cell as green (it leaves it white) and on "Red" it colors the cell as green. Here is the code I am using (I apologize it is bad as I am new to coding):

Sub SmartHighlight()
Dim Counter As Integer
Dim i As Integer
Dim j As Integer
Dim k As Range
Dim Chkr As Integer
Chkr = 0
xTitleId = "Smart Highlighter"
MsgBox "This macro analyzes the given pipe data to highlight completed sections."
For Each k In ActiveSheet.UsedRange.Rows
    Counter = 0
    i = 8
    For j = 0 To 3
        If ActiveSheet.Cells(k.Row, i).Value = 0 Then
            Counter = Counter + 1
        End If
        i = i + 1
    Next j
    If ActiveSheet.Cells(k.Row, 1) = "PIPE_ID" Then
        ActiveSheet.Cells(k.Row, 15).Value = "KEY:"
        ActiveSheet.Cells(k.Row, 16).Value = "White"
        ActiveSheet.Cells(k.Row, 17).Value = "Not yet completed."
        ActiveSheet.Cells(k.Row, 18).Value = "Grey"
        k.Cells(k.Row, 18).Interior.ColorIndex = 15
        ActiveSheet.Cells(k.Row, 19).Value = "Private."
    ElseIf ActiveSheet.Cells(k.Row, 1) = "" And Chkr = 0 Then
        ActiveSheet.Cells(k.Row, 16).Value = "Green"
        k.Cells(k.Row, 16).Interior.ColorIndex = 4
        ActiveSheet.Cells(k.Row, 17).Value = "Completed."
        Chkr = Chkr + 1
    ElseIf ActiveSheet.Cells(k.Row, 1) = "" And Chkr = 1 Then
        ActiveSheet.Cells(k.Row, 16).Value = "Red"
        k.Cells(k.Row, 16).Interior.ColorIndex = 3
        ActiveSheet.Cells(k.Row, 17).Value = "Error/Incomplete."
    ElseIf ActiveSheet.Cells(k.Row, 4) = "PRIVATE PIPE" Then
        k.EntireRow.Interior.ColorIndex = 15
    ElseIf Counter <> 4 Then
        k.EntireRow.Interior.ColorIndex = 4
    ElseIf Counter = 4 And ActiveSheet.Cells(k.Row, 14) = "" Then
        k.EntireRow.Interior.ColorIndex = 3
    End If
Next k



End Sub

And here is the output in excel: Click for Image

If anyone can help me correct the coloring error that would be most appreciated. Thanks!

Upvotes: 2

Views: 1394

Answers (2)

Tim Williams
Tim Williams

Reputation: 166825

It's unclear why you're switching between ActiveSheet.Cells and k.Cells ?

    ActiveSheet.Cells(k.Row, 18).Value = "Grey"
    k.Cells(k.Row, 18).Interior.ColorIndex = 15

In your code the Range k represent a single row in your sheet's data. You can get a reference to a single cell in that range using Cells(), but you need to be careful to use the correct index(es), otherwise you'll end up with a cell which is not even part of k.

For example, if k is set to row 4 on your sheet:

k.Cells(4).Address()

is D4, but

k.Cells(k.Row,4).Address() 'same as k.Cells(4, 4).Address()

is D7, not D4

k.Cells(1, 4).Address()

would be D4.

Upvotes: 2

Matti Ketonen
Matti Ketonen

Reputation: 23

I would propose you to make a sub procedure that will update the headers/keys etc. more static information when you run the macro.

This is what I ended up doing in one Excel macro gadget, a piece of the sub that draws the header rows:

Sub PrepareHeaders(szSheetName)
Sheets(szSheetName).Cells(iRow + 1, iCel) = "Add/Update"
Select Case szSheetName
    Case "Value Lists"
        Sheets(szSheetName).Cells(iRow + 1, iCel + 1) = "Object Type Name Singular"
        Sheets(szSheetName).Cells(iRow + 1, iCel + 2) = "Object Type Name Plural"
        Sheets(szSheetName).Cells(iRow + 1, iCel + 3) = "ID"
        Sheets(szSheetName).Cells(iRow + 1, iCel + 4) = "Real Object"
        Sheets(szSheetName).Cells(iRow + 1, iCel + 5) = "Owner Type ID"
        Sheets(szSheetName).Cells(iRow + 1, iCel + 6) = "Aliases"
    End Select
    Sheets(szSheetName).Rows(iRow + 1).Font.Bold = True
    Sheets(szSheetName).Columns("A:Z").EntireColumn.AutoFit
    Sheets(szSheetName).Cells(1, iCel).Select
End Sub

Additionally, you can use styles in your Excel sheet. Those styles can be called from VBA, and in case you need to change the color scheme or so, you can alter your style to apply formatting to whole spreadsheet.

Sheets(szSheetName).Cells(iRow + 1, iCel + 5).Style = "Input"

Another good thing to do is to fit your input, and finally select some specific cell.

Sheets(szSheetName).Columns("A:Z").EntireColumn.AutoFit
Sheets(szSheetName).Cells(1, iCel).Select

And one more thing, you may want to look for conditional formatting. That might provide one additional feature to use.

Upvotes: 0

Related Questions