Forum Discussion

Robert1290's avatar
Robert1290
Brass Contributor
Mar 19, 2021

Deleting entire columns if background colour is red

Hi,   I think I need VBA, but I would like to set something up that with a simple command I can remove entire columns from the spreadsheet if the background colour is red. I have office 365.   Th...
excel
Macros and VBA
office 365
HansVogelaar's avatar
HansVogelaar
MVP
Mar 20, 2021

Robert1290 

Here is a macro. Please test on a copy of your workbook first.

Sub DeleteRed()
    Dim rng As Range
    Application.ScreenUpdating = False
    With Application.FindFormat
        .Clear
        .Interior.Color = vbRed
    End With
    Set rng = Cells.Find(What:="", LookAt:=xlPart, SearchFormat:=True)
    Do While Not rng Is Nothing
        rng.EntireColumn.Delete
        Set rng = Cells.Find(What:="", LookAt:=xlPart, SearchFormat:=True)
    Loop
    Application.FindFormat.Clear
    Application.ScreenUpdating = True
End Sub
Robert1290's avatar
Robert1290
Brass Contributor
Mar 20, 2021

HansVogelaar

Thank you very much for this. I have never tried a macro before.
I think I need to open this in VBA? So alt f11 to open VBA, insert module, add this macro and alt f5 to run it?

Have I missed anything? And what do I need to do after these steps if they are right?

Apologies as new to all of this and trying to learn as I go!

 

update** I have run this, it has taken away the red columns but also the none red columns, everything has been deleted.

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Mar 20, 2021

    Robert1290 Did every column have at least one cell with a red background?

    • Robert1290's avatar
      Robert1290
      Brass Contributor
      Mar 20, 2021

      HansVogelaarNo it didn't, a lot of columns are white with black text.

       

      This may make a difference, the reason the columns are red are due to conditional formatting making them go red.

      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Mar 20, 2021

        Robert1290 

        Yes, that does make a difference. Here is a new version.

        Sub DeleteRed()
    Dim rng As Range
    Dim cel As Range
    Dim trg As Range
    Application.ScreenUpdating = False
    On Error Resume Next
    Set rng = Cells.SpecialCells(xlCellTypeAllFormatConditions)
    On Error GoTo 0
    For Each cel In rng
        If cel.DisplayFormat.Interior.Color = vbRed Then
            If trg Is Nothing Then
                Set trg = cel
            Else
                Set trg = Union(trg, cel)
            End If
        End If
    Next cel
    If Not trg Is Nothing Then
        trg.EntireColumn.Delete
    End If
    Application.ScreenUpdating = True
End Sub

Resources