×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

VBA - Delete Columns Based on Header Criteria or Empty Cells

VBA - Delete Columns Based on Header Criteria or Empty Cells

VBA - Delete Columns Based on Header Criteria or Empty Cells

(OP)
Also posted here:

https://stackoverflow.com/questions/50251293/vba-f...

Some of the sheets in my workbook do not have headers, so I use the below code to insert a blank row and assign a header to column A - I know column A will always be employee number.

CODE --> vba

Sub insertRow()

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("testWorkbook.xlsm")

    'Set sheets to be used in each workbook
    Set ws1 = wkbk1.Sheets("mySheet")
    Set ws2 = wkbk1.Sheets("hisSheet")
    Set ws3 = wkbk1.Sheets("herSheet")

    wkbk1.Activate

    ws1.Range("A1").EntireRow.Insert
    ws1.Range("A1").Value = "Employee Number"

    ws2.Range("A1").EntireRow.Insert
    ws2.Range("A1").Value = "Employee Number"

    ws3.Range("A1").EntireRow.Insert
    ws3.Range("A1").Value = "Employee Number"

End Sub 

The below code deletes columns based on the header name.

CODE --> vba

Sub ManipulateSheets()

    Dim a As Long, w As Long
    Dim keepCols As Variant
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("testWorkbook.xlsm")

    keepCols = Array("Employee Number", "Status")

    wkbk1.Activate

    With wkbk1

        For w = 1 To .Worksheets.count

            With Worksheets(w)

                For a = .Columns.count To 1 Step -1

                    If UBound(Filter(keepCols, .Cells(1, a), True, vbTextCompare)) < 0 Then _
                            .Columns(a).EntireColumn.Delete

                Next a

            End With

        Next w

    End With

End Sub 

The issue is this:

The 3 sheets that I insert a row in and set the column header for column A to Employee Number, still has empty headers for the remainder of the row.. So when I run the code above to delete the columns, nothing happens on these 3 sheets as there is no data to compare to in the header - the cells are empty..

So the two options I thought would work are:

1. Find the lastColumn and insert text into the cells between column A and the lastColumn

1.1. Find the last column that has data in it
1.2. Identify the column (lets assume column E) - at this point, we know from column A - E there is data in those columns
1.3. Set a loop from cell B1 - cell E1 to check if the cells are blank or not (I say cell B1 because I know cell A1 will contain "Employee Number")
1.4 If the cell is blank, insert the text "blank"
1.5. When I execute the macro that check column headers, it would therefore be able to check that from column B - E needs to be deleted because it has text and doesn't match the required text in the array

2. Find the lastColumn and include a criteria in the if statement that looks for blank cells as well as non-matching headers

I got the code to find the lastColumn here:

https://stackoverflow.com/questions/11926972/excel...

CODE --> vba

Sub findColumn()

    Dim rLastCell As Range
    Dim i As Long
    Dim MyVar As Variant
    Dim ws1 As Worksheet
    Dim wkbk1 As Workbook
    i = 2

    Set wkbk1 = Workbooks("testWorkbook.xlsm")

    Set ws2 = wkbk1.Sheets("ws1")

    Set rLastCell = ws2.Cells.Find(What:="*", After:=ws2.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

End Sub 

I managed to get the below - which removes columns with empty headers and those that do not match the array:

CODE --> vba

Sub DeleteIrrelevantColumns()

    Dim keepCols()
    Dim unionRng As Range, rng As Range
    Dim ws As Worksheet
    keepCols = Array("Employee Number", "Status")
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("testWorkbook.xlsm")

    For Each ws In wkbk1.Worksheets
        
        With ws
            
            If Application.WorksheetFunction.CountA(.Rows(1)) > 0 Then
                
                For Each rng In Intersect(.Rows(1), .UsedRange)
                    
                    If IsError(Application.Match(rng.Value, keepCols, 0)) Then
                        
                        If Not unionRng Is Nothing Then
                            
                            Set unionRng = Union(unionRng, rng)
                        
                        Else
                            
                            Set unionRng = rng
                        
                        End If
                    
                    End If
                
                Next rng
                
                If Not unionRng Is Nothing Then unionRng.EntireColumn.Delete
                    
                    Set unionRng = Nothing
                                    
                End If
        
        End With
    
    Next ws

End Sub 

So the above does work, but, it would appear as though it is getting stuck in an infinite loop. When I break the loop (Ctrl + Break) and I go through the sheets, then I see that it worked. I have tried letting the code just run, but it never stops.

RE: VBA - Delete Columns Based on Header Criteria or Empty Cells

Hi,

Looking for the cleanest approach...

CODE

Sub DeleteIrrelevantColumns()

    Dim keepCol 
    Dim ws As Worksheet
    keepCol = "Status"
    Dim wkbk1 As Workbook
    Dim c As Integer
    Dim rc As Range

    Set wkbk1 = Workbooks("testWorkbook.xlsm")

    For Each ws In wkbk1.Worksheets
        
        With ws
            For c = .UsedRange.Columns.Count to 2 Step -1
               Set rc = .Cells(1, c)
               If rc.Value = “” Then 
                  rc.EntireColumn.Delete
               Else
                  If rc.Value <> keepCol Then
                     rc.EntireColumn.Delete
                  End If
               End If
            Next
        End With
     Next 

The “secret” is that when deleting entire column or rows it is best done in reverse, else you loose your way.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: VBA - Delete Columns Based on Header Criteria or Empty Cells

(OP)
Thank you for your reply Skip..

Just one or two things..

I see in your reply you only using "Status" and not "Employee Number" & "Status".. Would this not delete the columns that have employee number as the header too?

And I believe at the end of your code where you have the "next", it should be "next ws"?

RE: VBA - Delete Columns Based on Header Criteria or Empty Cells

“Would this not delete the columns that have employee number as the header too?”

No. The loop ends at column 2 as you will note. As you stated, column A ALWAYS has the correct heading.

“And I believe at the end of your code where you have the "next", it should be "next ws"?”

Next is sufficient. Adding Next c, is merely optional. In this case with only one loop especially.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: VBA - Delete Columns Based on Header Criteria or Empty Cells

(OP)
"No. The loop ends at column 2 as you will note. As you stated, column A ALWAYS has the correct heading."

Ahhh my apologies, I didn't realize that your code took that into consideration..

Would you please show me where so that I know for future reference how to read it?

I think it could be this line:

CODE --> vba

For c = .UsedRange.Columns.count To 2 Step -1 

"Next is sufficient. Adding Next c, is merely optional. In this case with only one loop especially."

Thank you for this, I now understand the difference :)

RE: VBA - Delete Columns Based on Header Criteria or Empty Cells

“Would you please show me where so that I know for future reference how to read it?”

Show you what?

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: VBA - Delete Columns Based on Header Criteria or Empty Cells

@Skip: The OP was asking how you told the macro to stop at column 2. He guessed correctly.

RE: VBA - Delete Columns Based on Header Criteria or Empty Cells

(OP)
@DjangMan: Yes, that correct. Thank you :)

@Skip, thank you for your help :)

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close