Changing my code to keep certain columns instead of delete columns - excel

Question

I've frankensteined some code together which does the following:
Deletes first few rows in a worksheet if they're not the header names
Deletes columns with specific names
Does this for all worksheets in a specified folder
I need help updating the code to do the following:
If the first row already contains the headers, then it will just move to the next step
Keeps columns with specific names, delete the rest
Do this for all sheets within a worksheet, if there happen to be multiple ones
Thank you so much in advance for any help!
Option Explicit
Sub test()
Dim wkb As Workbook
Dim MyPath As String
Dim MyFile As String
Application.ScreenUpdating = False
Set wkb = ActiveWorkbook
MyPath = "C:\Users\Katerina Shapiro\Desktop\VBA" 'Change this based on your folder path'
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xlsx")
Do While Len(MyFile) > 0
If MyFile <> wkb.Name Then
Workbooks.Open Filename:=MyPath & MyFile
Dim rng As Range
Set rng = Range("B1:B4") 'Change this if there are more rows to be deleted before the header'
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Dim xFNum, xFFNum, xCount As Integer
Dim xStr As String
Dim xArrName As Variant
Dim MR, xRg As Range
On Error Resume Next
Set MR = Range("A1:H1")
xArrName = Array("Placement (detail) url", "Placement (group)") 'enclose each column name with double quotes and separate them by comma
xCount = MR.Count
xStr = xArrName(xFNum)
For xFFNum = xCount To 1 Step -1
Set xRg = Cells(1, xFFNum)
For xFNum = 0 To UBound(xArrName)
xStr = xArrName(xFNum)
If xRg.Value = xStr Then xRg.EntireColumn.Delete
Next xFNum
Next
ActiveWorkbook.Close SaveChanges:=True
End If
MyFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Completed...", vbInformation
End Sub

Answer 1

Should get you close:
Option Explicit
Sub test()
Dim wkb As Workbook, wbMod As Workbook, ws As Worksheet
Dim MyPath As String
Dim MyFile As String, h, keepCols, col As Long, i As Long
Application.ScreenUpdating = False
Set wkb = ActiveWorkbook 'ThisWorkbook ?
MyPath = "C:\Users\Katerina Shapiro\Desktop\VBA" 'Change this based on your folder path'
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
keepCols = Array("Placement (detail) url", "Placement (group)") 'columns to keep
MyFile = Dir(MyPath & "*.xlsx")
Do While Len(MyFile) > 0
If MyFile <> wkb.Name Then
Set wbMod = Workbooks.Open(Filename:=MyPath & MyFile) 'get reference to opened file
For Each ws In wbMod.Worksheets 'loop over worksheets
'remove any empty rows at the top of the sheet
i = 0
Do While Application.CountA(ws.Rows(1)) = 0
ws.Rows(1).Delete
i = i + 1
If i >= 5 Then Exit Do 'don't keep deleting forever...
Loop
'loop column headers in Row 1 right to left: delete column if header not in "keep" array
For col = ws.Cells(1, Columns.Count).End(xlToRight).Column To 1 Step -1
If IsError(Application.Match(ws.Cells(1, col).Value, keepCols, 0)) Then
ws.Columns(col).Delete
End If
Next col
Next ws
wbMod.Close True 'save changes
End If
MyFile = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Completed...", vbInformation
End Sub

Answer 2

For i = 1 To 2 'This for loop deletes all rows on top of the workbook where the cell in column B is empty
If Cells(i, 2).Value = "" Then
Rows(i).Delete
i = i - 1
End If
Next
This one should solve your first problem.
WS_Count = ActiveWorkbook.Worksheets.Count
For i = 1 To WS_Count
...
Next i
If you implement this loop it looks how many sheets there are in the workbook and loop through it.
For i=1 to Cells(7, sht.Columns.Count).End(xlToLeft).Column
If Cells(1,i).Value="" Then 'You need to insertthe Names of the columns you want to keep here.
columns(i).delete
i=i-1
endif
Next
And this should solve the columns delete problem.