VBA Code to change the font in a block of cells to white

Mr2017

Well-known Member
Joined
Nov 28, 2016
Messages
644
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi

I'd like to change the colour of the font in column A in specific cells to white, depending on the cells which are populated in column C.

I wrote a simple macro which copies data from Sheet 2 to Sheet 1 - please find below the scenario:

Sheet 2 has the values 4, 5 and 6 in cells A1, A2, and A3, respectively, like this:

[TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64, align: right"]4[/TD]
[/TR]
[TR]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD="align: right"]6[/TD]
[/TR]
</tbody>[/TABLE]

Sheet 1 has the values 1, 2, and 3 in cells B2, B3, and B4, like this:

[TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64, align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[/TR]
</tbody>[/TABLE]

The macro goes to the bottom of the range in column B and offsets 2 rows and inserts a title for the data brought in from Sheet 2.

It then copies the data from Sheet 2 into Sheet 1, below the title just inserted in Sheet 1.

In this case, the data from Sheet 2 is inserted into cells B7, B8 and B9.

Now this is the missing part: I'd like to make the font in cells A7, A8, and A9, white.

If A10 was populated with data from Sheet 2, then I'd want to make the font in A10 white, as well.

Please find below the code - I'd be grateful if someone could clarify what I need to add to the code.

TIA

Code:
Sub CopyOffsetPaste()




Sheet1.Activate


Range("b2").End(xlDown).Offset(2, 0).Select
ActiveCell.Value = "Let's get this party started!"


Sheet2.Activate
Range("a1", Range("a1").End(xlDown)).Copy


Sheet1.Activate
Range("b2").End(xlDown).Offset(3, 0).PasteSpecial xlPasteAll


End Sub
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Try

Code:
Sub CopyOffsetPaste()
Dim lr As Long

Sheet1.Activate

Range("b2").End(xlDown).Offset(2, 0) = "Let's get this party started!"

Sheet2.Activate
Range("a1", Range("a1").End(xlDown)).Copy

Sheet1.Activate
Range("b2").End(xlDown).Offset(3, 0).PasteSpecial xlPasteAll
srow = WorksheetFunction.Match("Let's get this party started!", Range("B:B")) + 1
lr = Cells(Rows.Count, "B").End(xlUp).Row
For x = srow To lr
    Cells(x, "A").Font.Color = RGB(255, 255, 255)
Next x

End Sub
 
Upvote 0
Another approach:
Code:
Sub CopyOffsetPaste()
    Application.ScreenUpdating = False
    Dim LastRow1 As Long, LastRow2 As Long, srcWS As Worksheet
    Set srcWS = Sheet2
    LastRow1 = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
    Sheet1.Range("B" & LastRow1 + 2) = "Let's get this party started!"
    srcWS.Range("A1", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp)).Copy Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Offset(1, 0)
    LastRow2 = Sheet1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A" & LastRow1 + 2 & ":A" & LastRow2).Font.Color = vbWhite
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks Scott T - quick question: do you know how to make this still work if there is an empty column between columns A and B?

So the font that would need to be changed to white would still be in column A, but the data copied from Sheet 2 would be in column C, instead of column B?

I thought I could just change the cell references, but that didn't work.

Thanks in advance.
 
Last edited:
Upvote 0
Thanks mumps. - quick question: do you know how to make this still work if there is an empty column between columns A and B?

So the font that would need to be changed to white would still be in column A, but the data copied from Sheet 2 would be in column C, instead of column B?

I thought I could just change the cell references, but that didn't work.

Thanks in advance.
 
Last edited:
Upvote 0
Try:
Code:
Sub CopyOffsetPaste()
    Application.ScreenUpdating = False
    Dim LastRow1 As Long, LastRow2 As Long, srcWS As Worksheet
    Set srcWS = Sheet2
    LastRow1 = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
    Sheet1.Range("C" & LastRow1 + 2) = "Let's get this party started!"
    srcWS.Range("A1", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp)).Copy Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Offset(1, 0)
    LastRow2 = Sheet1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A" & LastRow1 + 2 & ":A" & LastRow2).Font.Color = vbWhite
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Awesome!!

That worked on the sample code - just need to modify it and test it on the real code!

Thanks again!
 
Upvote 0

Forum statistics

Threads
1,223,948
Messages
6,175,580
Members
452,653
Latest member
craigje92

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