VBA code to remove/delete all text in cell range when the text is not black

[Detectiveclem]

Hi

Can anyone help me with VBA code for one worksheet please?

I want to be able to run an auto VBA code on a sheet (called "Results") so that when I copy a range of cells into cells A3:GF3 from another sheet, the text unless its black will be deleted leaving the cell blank. Therefore only those cells with black text will remain populated and the other cells will be empty.

FYI. I want to remove text where the cells containing grey, red and blue text etc.

Thanks for any help provided.

 

[nemmi69]

So far I have but seems to have issues

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

For Each Cell In Target
    If Cell.Font.Color <> vbBlack Then
          Cell.Delete
    End If
Next

End Sub

 

[Peter_SSs]

Test this worksheet change code with a copy of your workbook. To implement ..
1. Right click the Results sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cell As Range
  
  Application.ScreenUpdating = False
  For Each cell In Target
    If cell.Font.Color <> 0 Then cell.ClearContents
  Next cell
  Application.ScreenUpdating = True
End Sub

 

[Fluff]

@Peter_SSs
Don't you need to disable events with that code?

 

[Peter_SSs]

@Peter_SSs
Don't you need to disable events with that code?

Yes, should have done, thanks for catching.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cell As Range
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  For Each cell In Target
    If cell.Font.Color <> 0 Then cell.ClearContents
  Next cell
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

 

[Detectiveclem]

Yes, should have done, thanks for catching.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cell As Range
 
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  For Each cell In Target
    If cell.Font.Color <> 0 Then cell.ClearContents
  Next cell
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Hi Peter_SSs, this works far better than your first code, however the last three colums are missed (GD, GE and GF). Can you tell me how I include them.

Thank you so much, Paul

 

[Peter_SSs]

the last three colums are missed (GD, GE and GF).

Works for me in those three columns.

Are you actually pasting into those columns or do they already contain formulas that just reference data you are pasting into earlier columns?

 

[Detectiveclem]

Works for me in those three columns.

Are you actually pasting into those columns or do they already contain formulas that just reference data you are pasting into earlier columns?

Hi Peter_SSs, I will check again but I thought I was.
However, would it be possible to have a new code doing the same thing but which would work on cells A3: EX5000?

Thank you so much.

Paul

 

[Peter_SSs]

However, would it be possible to have a new code doing the same thing but which would work on cells A3: EX5000?

I actually did not put ant restrictions on the range so it should already work on any cells pasted anywhere in the sheet.

 

[Detectiveclem]

Hi Peter_SSs, I should have tried it before asking, but as you said it works anywhere from row 3. I really appreciate your help. Cheers Paul