Find colored cells and add colored border

[Son]

Hi, I have a sheet with some green colored cells and I'd like to change their borders. The numbers of green cells that need to be changed is identified based to another cell's value.

For each row, I need to find the first green cell from right to left and then add as many red borders as the number in the Value2 column.

Then, I need to find the next green cell to the left (after the cells with borders placed from value2), and add as many red borders as the number in the Value1 column.

In the example table above, the upper section shows the data that I currently have. The lower section is what I need to have after adding the borders with vba.

The numbers in columns for Value1 and Value2 are changing, they are not always the same. Also, the number of the green cells are not always the same.

I don't know how to find and select the cells to apply to code, but I know how to add the borders. I am using this code:

Sub Add_Borders()

Range("K15, I15, G15").Select

With Selection.Borders
            .LineStyle = XlLineStyle.xlContinuous
            .Weight = xlMedium
            .Color = RGB(255, 0, 0)
End With

With Selection.Borders(xlDiagonalUp)
            .LineStyle = XlLineStyle.xlContinuous
            .Weight = xlMedium 
            .Color = RGB(255, 0, 0)
End With

With Selection.Borders(xlDiagonalDown)
            .LineStyle = XlLineStyle.xlContinuous
            .Weight = xlMedium
            .Color = RGB(255, 0, 0)
End With

End Sub

Any ideas would be most appreciated!!!

 

[Osvaldo Palmeiro]

Hi. Try this, please.

Sub Add_Borders()
Dim r As Long, c As Long, x As Long, k As Long
  For r = 15 To 19 Step 2
   For c = 11 To 3 Step -2
    If Cells(r, c).Interior.Color <> 16777215 Then
     If k < Cells(r, 15) Then
      [O11].Copy Cells(r, c): k = k + 1
     ElseIf x < Cells(r, 13) Then
       [M11].Copy Cells(r, c): x = x + 1
     Else: Exit For
     End If
    End If
   Next c
   k = 0: x = 0
  Next r
End Sub

obs. In your desired result it seems that in PAUL's line, the third green cell should have two diagonals.

 

[Son]

Osvaldo, great solution!!! It worked perfectly!!!
Thank you so much!

Now that adding borders is solved, I have another problem, related to adding the borders. To define Value2, I use a value that counts green cells in each row. This counter is in column S. And when I run the macro to add borders then I get #Value error in column S that counts green cells. This means that the column with Value2 values shows the same error and the macro cannot continue.
Here is my example with the green count in column S:

The idea is that if I add/remove a green cell in a row, the Green Counter will make the calculation automatically. The code I am using for column S is the following:

Function GetColorCount(CountRange As Range, CountColor As Range)
Dim CountColorValue As Integer
Dim TotalCount As Integer
CountColorValue = CountColor.Interior.ColorIndex
Set rCell = CountRange
For Each rCell In CountRange
  If rCell.Interior.ColorIndex = CountColorValue Then
    TotalCount = TotalCount + 1
  End If
Next rCell
GetColorCount = TotalCount
End Function

I used to have application.volatile at the beginning but I removed it, and it still displays the errors in column S. Errors are also displayed in other times and I have not been able to determine the reason behind these errors. I usually double click on a cell or replace ":" with ":" in column S in an attempt to recalcuate all values in column S. This usuall fixes the errors. But, I need to send the workbook to end users and I'd like to find a solution for this before sending it.

In any case, the macro you sent me works, but not in conjunction with the getcolorcount function.

My end users will have excel 2016 or excel 2007 or other versions.

The easiest way would be to count green cells by hand, and remove the getcolorcount function.

But, maybe you would have any suggestions on how to face this problem?

 

[Son]

ok, I decided not to continue with the get colour function.
So, problem solved.
Thanks so much!
Son