Delete entire column if row 5 is blank

[Dokat]

Hi,

I have a file where i'd like to delete entire column where row #5 is blank. I have below code where it deletes entire column if it is completely blank.

I want to narrow it down and delete entire column if row 5 is blank in the range. Can anyone help me modify the code. My range is from column A through column BM. Thanks

Sub DeleteBlankColumns()

    Dim MyRange As Range
    Dim iCounter As Long

    Set MyRange = ActiveSheet.UsedRange
    
    For iCounter = MyRange.Columns.Count To 1 Step -1
    
       If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
       Columns(iCounter).Delete
       End If

    Next iCounter
End Sub

 

[Dokat]

I modified the code and below worked for me.

Sub DeleteBlankrow5blank()
Application.ScreenUpdating = False

    Dim MyRange As Range
    Dim iCounter As Long

    Set MyRange = ActiveSheet.UsedRange
                
    For iCounter = MyRange.Columns.Count To 1 Step -1
    
    Set rng = MyRange.Cells(5, iCounter)
    
       If rng.Value = 99 Then
        
       Columns(iCounter).Delete
 
      
              End If

    Next iCounter
    
 
 Application.ScreenUpdating = True
 
End Sub

 

[Peter_SSs]

i'd like to delete entire column where row #5 is blank.

If rng.Value = 99 Then

Which is it, blank or 99?

 

[Dokat]

Which is it, blank or 99?

Please disregard 99, i tested different values to see if it works. If you replace it with "" it will delete the column if it is blank. Above code worked for me.

 

[Peter_SSs]

If the cells are truly blank then this should work

Sub DeleteColumns_v1()
  On Error Resume Next
  Range("A5:BM5").SpecialCells(xlBlanks).EntireColumn.Delete
  On Error GoTo 0
End Sub

Or if the cells might contain (or have contained) "" and the other values are not formula results where the formula needs to be retained, then try

Sub DeleteColumns_v2()
  With Range("A5:BM5")
    .Value = Evaluate(Replace("if(#="""",TRUE,#)", "#", .Address))
    On Error Resume Next
    .SpecialCells(2, 4).EntireColumn.Delete
    On Error GoTo 0
  End With
End Sub

 

[Dokat]

If the cells are truly blank then this should work

Sub DeleteColumns_v1()
  On Error Resume Next
  Range("A5:BM5").SpecialCells(xlBlanks).EntireColumn.Delete
  On Error GoTo 0
End Sub

Or if the cells might contain (or have contained) "" and the other values are not formula results where the formula needs to be retained, then try

Sub DeleteColumns_v2()
  With Range("A5:BM5")
    .Value = Evaluate(Replace("if(#="""",TRUE,#)", "#", .Address))
    On Error Resume Next
    .SpecialCells(2, 4).EntireColumn.Delete
    On Error GoTo 0
  End With
End Sub

Thanks

 

[Peter_SSs]

You're welcome.

 

[Dokat]

If the cells are truly blank then this should work

Sub DeleteColumns_v1()
  On Error Resume Next
  Range("A5:BM5").SpecialCells(xlBlanks).EntireColumn.Delete
  On Error GoTo 0
End Sub

Or if the cells might contain (or have contained) "" and the other values are not formula results where the formula needs to be retained, then try

Sub DeleteColumns_v2()
  With Range("A5:BM5")
    .Value = Evaluate(Replace("if(#="""",TRUE,#)", "#", .Address))
    On Error Resume Next
    .SpecialCells(2, 4).EntireColumn.Delete
    On Error GoTo 0
  End With
End Sub

I'd like to run this code in two separate worksheets. One name Product and other name POS. How can i run it simultaneously?

 

[Peter_SSs]

I'd like to run this code ..

Which code?
You posted a code and I posted two of them so there are three to choose from. Which one does what you want the best?