Delete columns if headers contains "A, B... or Z"

[olbo1029]

Hi,

My name's Oliver and I'm currently writing my university thesis and need help with sorting out a lot of data.

Have several worksheets, where every worksheet contains between 1000-7500 columns with headers and data below. I want to delete the columns that contain certain texts (like INCI4MN, INCI5MN or INCI6MN) in the headers (row 4) because they are "empty" columns with only headers and no data below.

I've been searching for an answer but can only seem to find macros that delete all the columns in one worksheet at a time, containing only one text (like INCI4MN) in the headers. have attached the macro below.


Kind regards,
Oliver

------------------------------------------------------------------------------------------------------------------------------------------
Sub Col_Delete_by_Word()

Dim Found As Range, strWord As String, Counter As Long

strWord = Application.InputBox("Enter the word to search for.", "Delete the columns with this word", Type:=2)
If strWord = "False" Or strWord = "" Then Exit Sub 'User canceled

Set Found = Cells.Find(strWord, , , xlPart, , xlNext, False)

If Not Found Is Nothing Then

Application.ScreenUpdating = False
Do
Found.EntireColumn.Delete
Counter = Counter + 1
Set Found = Cells.Find(strWord, , , xlPart, , xlNext, False)

Loop Until Found Is Nothing
Application.ScreenUpdating = True

MsgBox Counter & " columns deleted.", vbInformation, "Process Complete"

Else
MsgBox "No match found for: " & strWord, vbInformation, "No Match"
End If

End Sub

 

[FormR]

Hi, welcome to the forum!

Here is one way you could try:

Sub DeleteCols()
Const ColNamesToDelete As String = "INCI4MN,INCI5MN,INCI6MN" 'Headers to delete - comma seperated
Dim v, ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    For Each v In Split(ColNamesToDelete, ",")
        ws.Rows(4).Replace What:=v, Replacement:="#N/A", LookAt:=xlWhole
    Next v
    On Error Resume Next
    ws.Rows(4).SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Delete
    On Error GoTo 0
Next ws
End Sub

 

[oldbrewer]

I would insert a new row 1 and in it put =counta(a2:A50000)

where the value given is 1 delete that column
easy to do it with a macro containing if Cells(1,J)=1 then delete code here

 

[Fishboy]

Hi,

My name's Oliver and I'm currently writing my university thesis and need help with sorting out a lot of data.

Have several worksheets, where every worksheet contains between 1000-7500 columns with headers and data below. I want to delete the columns that contain certain texts (like INCI4MN, INCI5MN or INCI6MN) in the headers (row 4) because they are "empty" columns with only headers and no data below.

I've been searching for an answer but can only seem to find macros that delete all the columns in one worksheet at a time, containing only one text (like INCI4MN) in the headers. have attached the macro below.


Kind regards,
Oliver

------------------------------------------------------------------------------------------------------------------------------------------
Sub Col_Delete_by_Word()

Dim Found As Range, strWord As String, Counter As Long

strWord = Application.InputBox("Enter the word to search for.", "Delete the columns with this word", Type:=2)
If strWord = "False" Or strWord = "" Then Exit Sub 'User canceled

Set Found = Cells.Find(strWord, , , xlPart, , xlNext, False)

If Not Found Is Nothing Then

Application.ScreenUpdating = False
Do
Found.EntireColumn.Delete
Counter = Counter + 1
Set Found = Cells.Find(strWord, , , xlPart, , xlNext, False)

Loop Until Found Is Nothing
Application.ScreenUpdating = True

MsgBox Counter & " columns deleted.", vbInformation, "Process Complete"

Else
MsgBox "No match found for: " & strWord, vbInformation, "No Match"
End If

End Sub

Hi olbo1029, welcome to the boards.

Depending on how many sheets you have in the workbook and just how many thousands of columns we are dealing with per sheet, the following solution may be a little slow (possibly multiple minutes) but will do as you describe. Work through each sheet in the workbook, looking at values in row 4, and if the value is any of the 3 listed then that column will be deleted:

Sub DeleteColumns()
' Defines variables
Dim x As Long, cRange As Range, ws As Worksheet
' Disable screen updating to reduce flicker
Application.ScreenUpdating = False


' For each worksheet in your workbook
For Each ws In ActiveWorkbook.Worksheets
    ' Defines LastCol as the last column of data based on row 4
    LastCol = ws.Cells(4, Columns.Count).End(xlToLeft).Column
    
    ' Sets the check range as A4 to the last column of row 4
    Set cRange = ws.Range("A4", ws.Cells(4, LastCol))
    
    ' For each cell in the check range, working backwards from the end to the start
    For x = cRange.Columns.Count To 1 Step -1
        With cRange.Cells(x)
            ' If the cell value is one of the listed values then...
            If .Value = "INCI4MN" Or .Value = "INCI5MN" Or .Value = "INCI6MN" Then
                ' Delete that column
                .EntireColumn.Delete
            End If
        End With
    ' Check next cell in check range
    Next x
' Next worksheet
Next ws


' Re-enable screen updating
Application.ScreenUpdating = True
' Message box confirming the check is complete
MsgBox "All columns that met criteria have been deleted"


End Sub

 

[olbo1029]

I'm always amazed at how experts help people like me, thanks alot for quick and correct answers, all of you have saved me lots of time!

Used a combo of "counta" and Fishboy's suggestion, it seemed to be the most accurate way to remove unnecessary columns.


Kind regards,
Oliver

 

[oldbrewer]

I could not have managed without Fishboy.............

 

[Fishboy]

I'm always amazed at how experts help people like me, thanks alot for quick and correct answers, all of you have saved me lots of time!

Used a combo of "counta" and Fishboy's suggestion, it seemed to be the most accurate way to remove unnecessary columns.


Kind regards,
Oliver

Happy to help. Glad to hear you got it sorted.