Compare Column Headings and Delete Nonmatch

[bthurman]

Any help on the situation below would be greatly appreciated.

I am trying to write VBA code to accomplish the following.


I am working with 2 seperate files. Let's refer to them as (File 1) and
(Template 1).

After opening (File 1), I need to compare the number of columns with
headings to the number of columns with headings in
(Template 1). If the number of columns in (File 1) exceeds the number in
(Template 1) than I must now examine each of the column headings in (File 1)
to determine which of these does not exist in (Template 1). I will delete the
entire column from (File 1) after determining which it is.

Thanks in advance for your help.

Bob

 

[Leith Ross]

Any help on the situation below would be greatly appreciated.

I am trying to write VBA code to accomplish the following.


I am working with 2 seperate files. Let's refer to them as (File 1
and
(Template 1).

After opening (File 1), I need to compare the number of columns with
headings to the number of columns with headings in
(Template 1). If the number of columns in (File 1) exceeds the numbe
in
(Template 1) than I must now examine each of the column headings i
(File 1)
to determine which of these does not exist in (Template 1). I wil
delete the
entire column from (File 1) after determining which it is.

Thanks in advance for your help.

Bob

Hello Bob,

This macro will compare the columns of "Sheet1" in the workbook "Fil
1" with the columns of "Sheet1" in the workbook "Template 1". You ca
the workbook and sheet names in the macro to what you are using.

=========================
Sub CompareColumns()

Dim C As Long
Dim DSO As Object
Dim LastColMain As Long
Dim LastCol2 As Long
Dim MainList As Object
Dim WksMain As Worksheet
Dim Wks2 As Worksheet

Set WksMain = Workbooks("Template 1").Worksheets("Sheet1")
Set Wks2 = Workbooks("File 1").Worksheets("Sheet1")

LastColMain = WksMain.Cells(1
Columns.Count).End(xlToLeft).Column
LastCol2 = Wks2.Cells(1, Columns.Count).End(xlToLeft).Column

Set MainList = CreateObject("Scripting.Dictionary")
MainList.CompareMode = vbTextCompare

For C = 1 To LastColMain
With WksMain
If .Cells(1, C) <> "" Then
If Not MainList.Exists(.Cells(1, C).Text) Then
MainList.Add .Cells(1, C).Text, 1
End If
End If
End With
Next C

X = MainList.Exists("B")
For C = LastCol2 To 1 Step -1
With Wks2
If .Cells(1, C) <> "" Then
If Not MainList.Exists(.Cells(1, C).Text) = True Then
.Columns(C).EntireColumn.Delete
End If
End If
End With
Next C

Set MainList = Nothing

End Sub
========================

--
Leith Ros

Sincerely,
Leith Ross

'The Code Cage' (http://www.thecodecage.com/

 

[bthurman]

Leith,

Your solution is just what I needed. Works great. Thanks so much for your
help.

Bob