Using active cell to set text and fill colour of other cells in a multiple selection

jmason

New Member
Joined
May 2, 2014
Messages
17
I am trying to come up with a way in VB to apply the text and fill colour of the active cell to the rest of the selection in a spread sheet.
I feel like I should be able to use a combination of:
activecell, font.color and interior.color to do what I want but I am struggling to work out how to apply it to the rest of the selected cells.

Below is a screen shot of the sheet I am working with:

screenshot.1.jpg

So I am selecting unformatted cells (grey above) and then want to select one of the big coloured cells at the bottom last and have a macro that can be triggered to set all cells to that font and fill colour.

Any ideas appreciated.

Thanks in advance,

John.
 
The bold part is exactly how the code is meant to work. You can still use Ctrl+click to select multiple non-contiguous cells and then click one of the coloured cells to change the colour of all the selected cells.


Rather than specifying the exact addresses of the coloured cells - Range("J16,M16,P16,S16,V16,Y16,AB16") - the code below specifies the initials in those coloured cells - FR,TH,SW,LS,LL,KE,WLM. This means the code will still work if you add or remove columns or rows and will need changing only if the initials change. I notice that the coloured cells are each 4 merged cells, so an extra check to ensure that one of coloured cells has been selected is Target.Count = 4.

Of course a simple in string would work far easier than all the things I was fiddling with.

This issue is slightly harder to handle. If you only select multiple grey cells (never a single grey cell) before selecting one of the coloured cells then a simple Target.Count check could be used. However I'm sure you want the ability to select a single grey cell to change its colour.

Interestingly although occasionally I may have need to add a single cell the usual way the sheet is worked on is to add all the cells of one colour then set their colour. So it is unusual enough to mean that the need to select any other cell of the same colour when only selecting one cell is preferable to the risk of accidentally colouring a cell and not know which one it was as I can't just undo the action.
To that end i have added that as another If and all seems to be working.

The check I've gone with is very simple - it checks that there is a gap of at least 3 rows between the first row of the previously selected grey cells and the clicked coloured cell. Looking at your screenshot, I think this 3 row gap should work for you because the coloured cells are in row 16 and the lowest grey cell is in row 13.

Although in my example the last boarded row isn't filled in it will be once clubs start so I have reduced the count to 2 to allow for this. I think those two protections are enough to minimise the possibility of me messing up the sheet with this automation.

Below is the code I have ended up with.

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Static greyCellsSelection As Range

    If Target.Count = 4 And InStr(",FR,TH,SW,LS,LL,KE,WLM,", "," & Target(1).Value & ",") Then
        If Not greyCellsSelection Is Nothing Then
            If greyCellsSelection.Count >= 2 Then
                If Target.Row - greyCellsSelection.Row >= 2 Then
                    greyCellsSelection.Interior.Color = Target.Interior.Color
                    greyCellsSelection.Font.Color = Target.Font.Color
                    Set greyCellsSelection = Nothing
                 End If
            End If
        End If
    Else
        Set greyCellsSelection = Target
    End If
    
End Sub

Thank you again for the assistance with this. I only wish I had cause to write VBA more than about once a year when I discover I have exceeded Excels abilities. Then maybe I would actually remember some of this stuff.

One day I will get round to putting in another macro that can do all the Super and subscripting for me. At the moment I have a macro that will do the subscripting at a key press for the ones that are single line but for the double line ones I have added super and sub script to the quick access tool bar so I can switch them on and off as I type with Alt-5 and Alt-6.

Thanks again for your help.

John.
 
Upvote 0

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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
Back
Top