Find the column named "Purple" & delete the whole column if there are no blank cells

Hello Duugg,

This macro finds the columns, and makes the "Purple" column the same size as "Customer Number" column. The "Purple" column is then checked for any blanks. If any blanks are found then the entire column is deleted.

Sub Macro1()

  Dim Col As Long
  Dim LastCol As Long
  Dim Rng As Range
  Dim Rng1 As Range
  Dim Rng2 As Range

    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set Rng = Range("A1", Cells(1, LastCol))
      
    For Each Cell In Rng
      Col = Col + 1
      Select Case Rng.Value
        Case Is = "Customer Number"
          Set Rng1 = Cells(Rows.Count, Col).End(xlUp)
        Case Is = "Purple"
          Set Rng2 = Cells(Rows.Count, Col).End(xlUp)
          Set Rng2 = Resize(Rng1.Rows.Count, 1)
      End Select
    Next Cell
    
    If Rng1 Is Nothing Then
       MsgBox "Customer Number column not found."
       Exit Sub
    End If
    
    If Rng2 Is Nothing Then
       MsgBox "Purple column not found."
       Exit Sub
    End If
    
    On Error Resume Next
      Col = Rng2.SpecialCells(xlCellTypeBlanks).Count
      If Err = 0 Then Rng2.EntireColumn.Delete
      
End Sub

Hello Duugg,

It appears I left off a qualifier on the Resize method.

Sub Macro1()

  Dim Col As Long
  Dim LastCol As Long
  Dim Rng As Range
  Dim Rng1 As Range
  Dim Rng2 As Range

    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set Rng = Range("A1", Cells(1, LastCol))
      
    For Each Cell In Rng
      Col = Col + 1
      Select Case Rng.Value
        Case Is = "Customer Number"
          Set Rng1 = Cells(Rows.Count, Col).End(xlUp)
        Case Is = "Purple"
          Set Rng2 = Cells(Rows.Count, Col).End(xlUp)
          Set Rng2 = Rng2.Resize(Rng1.Rows.Count, 1)
      End Select
    Next Cell
    
    If Rng1 Is Nothing Then
       MsgBox "Customer Number column not found."
       Exit Sub
    End If
    
    If Rng2 Is Nothing Then
       MsgBox "Purple column not found."
       Exit Sub
    End If
    
    On Error Resume Next
      Col = Rng2.SpecialCells(xlCellTypeBlanks).Count
      If Err = 0 Then Rng2.EntireColumn.Delete
      
End Sub

Hello Duugg,

I have had such bad luck answering your posts. Which line has the error?

Hello Duugg,

Thanks, found the problem. I used Rng instead of Cell. Here is the corrected and working code...

Sub Macro1()

  Dim Cell As Range
  Dim Col As Long
  Dim LastCol As Long
  Dim Rng As Range
  Dim Rng1 As Range
  Dim Rng2 As Range

    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set Rng = Range("A1", Cells(1, LastCol))
      
    For Each Cell In Rng
      Col = Col + 1
      Select Case Cell.Value
        Case Is = "Customer Number"
          Set Rng1 = Cells(Rows.Count, Col).End(xlUp)
        Case Is = "Purple"
          Set Rng2 = Cells(Rows.Count, Col).End(xlUp)
          Set Rng2 = Rng2.Resize(Rng1.Rows.Count, 1)
      End Select
    Next Cell
    
    If Rng1 Is Nothing Then
       MsgBox "Customer Number column not found."
       Exit Sub
    End If
    
    If Rng2 Is Nothing Then
       MsgBox "Purple column not found."
       Exit Sub
    End If
    
    On Error Resume Next
      Col = Rng2.SpecialCells(xlCellTypeBlanks).Count
      If Err = 0 Then Rng2.EntireColumn.Delete
      
End Sub