Loop Through Column Headings and Delete Columns

[mikey3580]

Hello,

I have a bunch of different files that are all uniquely named with each of the column headings in 30 Columns starting in Column C.

I am trying to loop through row 1 where the column headings are and delete the columns that do not match the file name. Then move to the next file.

Below is what I have but I am a novice and can't get it work.

Any help would be appreciated!

Thanks

 Sub Resave()
  Dim Outpath As String
  Dim InputPath As String
  Dim rngNames As Excel.Range
  Dim rng As Excel.Range
  Dim wkbTemplate As Excel.Workbook
  Dim FileName As String
  Dim c As Range
  Dim myOutput As String
  Dim mypath As String
 
  Outpath = ActiveWorkbook.Path & "\Output\"
 
  FileName = Dir(Outpath & "*.*")
 
            Do While FileName <> ""
                Workbooks.Open FileName:=Outpath & FileName, ReadOnly:=False
                   
 'Retrieve ActiveWorkbook's File Path
mypath = ActiveWorkbook.FullName
 
'Take Off The File Extension
  myOutput = Left(mypath, InStrRev(mypath, ".") - 1)
 
'Retrieve File Extension
  myOutput = Right(mypath, Len(mypath) - InStrRev(mypath, "."))
 
'Retrieve File Name with Extension
  myOutput = Right(mypath, Len(mypath) - InStrRev(mypath, "\"))
 
'Retrieve File Name without Extension
  myOutput = Mid(mypath, InStrRev(mypath, "\") + 1, InStrRev(mypath, ".") - InStrRev(mypath, "\") - 1)
 
        
        'NEED HELP HERE
        Last = Cells(1, Columns.Count).End(xlToLeft).Column
        For i = Last to 3 Step -1
          If Cells(1, i).Value <> myOutput Then
                Cells(1, i).Value.EntireColumn.Delete
        End If
        Next i
                    Workbooks(FileName).Save
                    ActiveWorkbook.Close
                    FileName = Dir()
        Loop
       
        End Sub

[alansidman]

What is not working here? Are you getting an error message. Perhaps load a sample file that represents an actual file.

[mikey3580]

Hi,
Getting runtime error 424 - Object Required
On line

Cells(1, i).Value.EntireColumn.Delete

Appreciate the help!

[alansidman]

Try taking out .value from the line of code so it reads

cells(1,i).EntireColumn.Delete

[mikey3580]

That's it! Thanks for that!

[Alf]

Some small additions / changes you can do.

You have "Dim'ed" all your variables except i so you could add

Dim i As Integer

and you could change

 Workbooks(FileName).Save
      ActiveWorkbook.Close

to

Workbooks(FileName).Close SaveChanges:=True

Alf