VBA - Find lastColumn and Check if First Row Is Empty - vba

Question

I am not too sure how I should solve this issue, but there are two methods that make sense to me..
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.
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.
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.
So the two options I thought would work are:
Find the lastColumn and insert text into the cells between column A and the lastColumn
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:
Excel VBA- Finding the last column with data
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'm thinking of a Do While Loop along the lines of the below:
Do While (MyVar1 >= 2 And MyVar1 < rLastCell.Column)
Loop

Answer 1

You could change the condition to
IsError(Application.Match(rng.Value, keepCols, 0))
That picks up all non-matching items.
Note:
For Each rng In Intersect(.Rows(1), .UsedRange)
The above is going to loop through the used range of row 1 in the selected sheet.
Looping multiple sheets might be something like:
Option Explicit
Sub test()
Dim keepCols()
keepCols = Array("Employee Number", "Status")
Dim unionRng As Range, rng As Range, ws As Worksheet
For Each ws In ThisWorkbook.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
Debug.Print unionRng.EntireColumn.Address 'unionRng.EntireColumn.Delete '. ''<== Swop when ready to delete
Set unionRng = Nothing
End If
End If
End With
Next ws
End Sub