Find colored cells and add colored border

Son

Active Member
Joined
Mar 19, 2010
Messages
284
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.

1620247165903.png


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:


VBA 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!!!
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Osvaldo Palmeiro

Well-known Member
Joined
Feb 24, 2009
Messages
690
Office Version
  1. 365
Platform
  1. Windows
Hi. Try this, please.
VBA Code:
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.
 
Solution

Son

Active Member
Joined
Mar 19, 2010
Messages
284
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:
1620286384455.png


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:

VBA Code:
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

Active Member
Joined
Mar 19, 2010
Messages
284
ok, I decided not to continue with the get colour function.
So, problem solved.
Thanks so much!
Son
 

Forum statistics

Threads
1,141,309
Messages
5,705,674
Members
421,404
Latest member
Mikecollo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top