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

[jmason]

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:

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.

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. When you select one of the big coloured cells at the bottom, you will be prompted to select the cells you want to format. Click on the first cell to format and then hold down the CTRL key to select the remaining cells to format. When done, click the 'OK' button.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Select Case Target(1).Address
        Case "$J$16", "$M$16", "$P$16", "$S$16", "$V$16", "$Y$16", "$AB$16"
            Application.ScreenUpdating = False
            Dim rng As Range
            Set rng = Application.InputBox(Prompt:="Select a range to format.", Title:="Range Selection", Type:=8)
            With rng
                .Font.Color = Target.Font.Color
                .Interior.ColorIndex = Target.Interior.ColorIndex
            End With
            Application.ScreenUpdating = True
    End Select
End Sub

 

[John_w]

The same approach, without any prompting. Code goes in the worksheet module.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Static greyCellsSelection As Range
      
    If Not Intersect(Target, Range("J16,M16,P16,S16,V16,Y16,AB16")) Is Nothing Then
        If Not greyCellsSelection Is Nothing Then
            greyCellsSelection.Interior.Color = Target.Interior.Color
            greyCellsSelection.Font.Color = Target.Font.Color
            Set greyCellsSelection = Nothing
        End If
    Else
        Set greyCellsSelection = Target
    End If
   
End Sub

 

[jmason]

Thank you for both of these. I like both but will probably implement the second one if I can resolve one little niggle.

I had assumed given it was using intersect that it would require the large coloured square to be part of a Ctrl selected range but in fact (as I discovered by accident) if I have selected my range of cells and then just click into a large coloured cell it will set the colour of the cells that were previously selected.

The issue this causes is that if you navigate into any of the large squares then whatever cell you were in before changes its colours even if you are navigating around the sheet with the cursor keys or just manage to click into one by accident whatever cell you were just in changes.

Any thoughts as to how to resolve this issue.

The other reason it might be an issue , other than my inability to avoid those cells at other times, is that the sheet layout can change each September requiring extra columns to be added or removed from the 'Other Rooms' sections. This means I have to rejig the large cells. I can easily amend the macro once a year to reflect any movement or even for that matter, given they are unique values within the sheet, code it such that it automatically generates the cell references that go into the intersect statement. However if every time I enter the cell it changes what I was last in it may cause other issues.

Thanks again for your help.

Cheers,

John.

 

[jmason]

Application.ScreenUpdating = False

I did like this method and may still use it if I can't iron out the little niggle with the other one but can I ask is there a good reason why ScreenUpdating shouldn't be set to True?

Cheers,

John

 

[mumps]

With this version you would have to double click the large cell instead of just clicking on it.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Select Case Target(1).Address
        Case "$J$16", "$M$16", "$P$16", "$S$16", "$V$16", "$Y$16", "$AB$16"
            Application.ScreenUpdating = False
            Dim rng As Range
            Set rng = Application.InputBox(Prompt:="Select a range to format.", Title:="Range Selection", Type:=8)
            With rng
                .Font.Color = Target.Font.Color
                .Interior.ColorIndex = Target.Interior.ColorIndex
            End With
            Application.ScreenUpdating = True
    End Select
End Sub

 

[jmason]

With this version you would have to double click the large cell instead of just clicking on it.
[

Cheers for that update. I will merge it in with my tweeks that I was doing, like switching to color rather than colorindex as several of those colours are rgb values as they need to print particular colors. I have also been working to get the input box to show the big square text as a visual confirmation that the correct square had been clicked on.

Is there any reason why I can't set the ScreenUpdating to True as the main table only just fits on screen so if it is partially off screen when you click the big square you can't move around to get it back.

Thanks again,
John

 

[mumps]

The code I suggested already sets it to TRUE.

 

[jmason]

Doh!
So it does just further down than the one I saw earlier.
Sorry.
John

 

[John_w]

I had assumed given it was using intersect that it would require the large coloured square to be part of a Ctrl selected range but in fact (as I discovered by accident) if I have selected my range of cells and then just click into a large coloured cell it will set the colour of the cells that were previously selected.

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.

The other reason it might be an issue , other than my inability to avoid those cells at other times, is that the sheet layout can change each September requiring extra columns to be added or removed from the 'Other Rooms' sections. This means I have to rejig the large 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.

The issue this causes is that if you navigate into any of the large squares then whatever cell you were in before changes its colours even if you are navigating around the sheet with the cursor keys or just manage to click into one by accident whatever cell you were just in changes.

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.

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.

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 Target.Row - greyCellsSelection.Row >=3 Then
                greyCellsSelection.Interior.Color = Target.Interior.Color
                greyCellsSelection.Font.Color = Target.Font.Color
                Set greyCellsSelection = Nothing
            End If
        End If
    Else
        Set greyCellsSelection = Target
    End If
    
End Sub