VBA ammendment to code. Column Heading Changes for different Workbooks

[Conell8383]

<tbody>
[TD="class: votecell"]

down votefavorite
​

[/TD]
[TD="class: postcell"]I hope you can help. I have a some code below which works fine. What it does is opens up a dialog box allows a user to select an excel file, once this file is selected.
The code looks through the column headings find the Text "CountryCode" then cuts this column puts it into Column F then separates column F into new worksheets based on the country.
This issue I am facing is that sometimes the the column I want to cut contains the text "ClientField10" or "ClientField1"
So what I would like the macro to do is search the column headings for "CountryCode" if this is found fine execute the rest of the code.
If it is NOT found search for "CleintField10" then if found execute and if neither "CountyCode" or "CleintField10" is found search for "CleintField1" then execute the rest of the code
My code is below as always any help is greatly appreciated.

Sub Open_Workbook_Dialog()


Dim my_FileName As Variant
Dim my_Workbook As Workbook


  MsgBox "Pick your TOV file" '<--| txt box for prompt to pick a file


  my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection


  If my_FileName <> False Then
    Set my_Workbook = Workbooks.Open(Filename:=my_FileName)


    Call Sample(my_Workbook) '<--|Calls the Filter Code and executes


    Call Filter(my_Workbook) '<--|Calls the Filter Code and executes


  End If
End Sub


Public Sub Sample(my_Workbook As Workbook)
  Dim ws As Worksheet
  Dim aCell As Range, Rng As Range
  Dim col As Long, lRow As Long
  Dim colName As String


  '~~> Change this to the relevant sheet
  Set ws = my_Workbook.Sheets(1)
  With ws
    Set aCell = .Range("A1:BB50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _
                MatchCase:=False, SearchFormat:=False)
    '~~> If Found
    If Not aCell Is Nothing Then
      '~~> Cut the entire column


      aCell.EntireColumn.Cut


      '~~> Insert the column here


      Columns("F:F").Insert Shift:=xlToRight
    Else
      MsgBox "Country Not Found"
    End If
  End With
End Sub


Public Sub Filter(my_Workbook As Workbook)
  Dim rCountry As Range, helpCol As Range


  With my_Workbook.Sheets(1) '<--| refer to data worksheet
    With .UsedRange
      Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '<--| get a "helper" column just at the right of used range, it'll be used to store unique country names in
    End With


    With .Range("A1:Q" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| refer to its columns "A:Q" from row 1 to last non empty row of column "A"
      .Columns(6).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '<-- call AdvancedFilter on 6th column of the referenced range and store its unique values in "helper" column
      Set helpCol = Range(helpCol.Offset(1), helpCol.End(xlDown)) '<--| set range with unique names in (skip header row)
      For Each rCountry In helpCol '<--| iterate over unique country names range (skip header row)
        .AutoFilter 6, rCountry.Value2 '<--| filter data on country field (6th column) with current unique country name
        If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered...
          Worksheets.Add Worksheets(Worksheets.Count) '<--... add new sheet
          ActiveSheet.Name = rCountry.Value2  '<--... rename it
          .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header
        End If
      Next
    End With
    .AutoFilterMode = False '<--| remove autofilter and show all rows back
  End With
  helpCol.Offset(-1).End(xlDown).Clear '<--| clear helper column (header included)
End Sub

[/TD]

</tbody>

 

[BKrukowski]

By using the Else condition you can reset ACell to look for ClientField 10 and ClientField1. As soon as one of them are true the code breaks to the end of the nested IF...ThenElse

If Not aCell Is Nothing Then
      '~~> Cut the entire column

      aCell.EntireColumn.Cut         '~~> Insert the column here

    Columns("F:F").Insert Shift:=xlToRight


    Else
      MsgBox "Country Not Found"

       Set aCell = .Range("A1:BB50").Find(What:="ClientField10", LookIn:=xlValues, LookAt:=xlWhole, _
                MatchCase:=False, SearchFormat:=False)

         If Not aCell Is Nothing Then      '~~> Cut the entire column

      aCell.EntireColumn.Cut         '~~> Insert the column here

    Columns("F:F").Insert Shift:=xlToRight


    Else
      MsgBox "ClientField10 Not Found"

       Set aCell = .Range("A1:BB50").Find(What:="ClientField1", LookIn:=xlValues, LookAt:=xlWhole, _
                MatchCase:=False, SearchFormat:=False)

     If Not aCell Is Nothing Then      '~~> Cut the entire column

      aCell.EntireColumn.Cut         '~~> Insert the column here

    Columns("F:F").Insert Shift:=xlToRight



    End If 
    End If
    End If

 

[Conell8383]

@ BKrukowski: Thank you so much for taking the time to give me the code it was a big help. I eventually got the solution through your code and perseverance. my code is below. I just wanted to share as it may be helpful to some other Excel enthusiast

Sub test()
Dim acell As Range
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets(1)    'define ws
Set acell = ws.Range("A1:BB50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False)    'define acell as location of "countrycode"


If Not acell Is Nothing Then     'if address is found do the cut & insert of that column
  acell.EntireColumn.Cut
  Columns("F:F").Insert Shift:=xlToRight
ElseIf acell Is Nothing Then         'if address is not found redefine acell to look for "clientfield10"
    Set acell = ws.Range("A1:BB50").Find(What:="ClientField10", LookIn:=xlValues, LookAt:=xlWhole, _
    MatchCase:=False, SearchFormat:=False)


    If Not acell Is Nothing Then    'if address is found do the cut & insert
        acell.EntireColumn.Cut
        Columns("F:F").Insert Shift:=xlToRight
    ElseIf acell Is Nothing Then    'If not found redefine acell again to look for "ClientField1"
           Set acell = ws.Range("A1:BB50").Find(What:="ClientField1", LookIn:=xlValues, LookAt:=xlWhole, _
           MatchCase:=False, SearchFormat:=False)


            If Not acell Is Nothing Then    'If found do cut and insert
            acell.EntireColumn.Cut
            Columns("F:F").Insert Shift:=xlToRight
            Else: MsgBox "Country Not Found"    'If none can be found display msgbox
            End If
    End If
End If    'close all the If loops
End Sub