Compare Column Headings and Delete Nonmatch
 

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

Compare Column Headings and Delete Nonmatch
 

bthurman;209702 Wrote:
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

Hello Bob,

This macro will compare the columns of "Sheet1" in the workbook "File
1" with the columns of "Sheet1" in the workbook "Template 1". You can
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 Ross

Sincerely,
Leith Ross

'The Code Cage' (http://www.thecodecage.com/)
------------------------------------------------------------------------
Leith Ross's Profile: http://www.thecodecage.com/forumz/member.php?userid=75
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=57552

Compare Column Headings and Delete Nonmatch
 

Leith,

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

Bob

"Leith Ross" wrote:


bthurman;209702 Wrote:
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

Hello Bob,

This macro will compare the columns of "Sheet1" in the workbook "File
1" with the columns of "Sheet1" in the workbook "Template 1". You can
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 Ross

Sincerely,
Leith Ross

'The Code Cage' (http://www.thecodecage.com/)
------------------------------------------------------------------------
Leith Ross's Profile: http://www.thecodecage.com/forumz/member.php?userid=75
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=57552