CODEWITHSUNDEEP
vbaexcelmacros
Philip Connell
Philip Connell

Reputation: 651

Joining Two Macros

I hope you are well and can help. I have two pieces of code that I am trying to join into one Macro.

The first piece of code I have allows a user to click on a command button that opens up a txt box and allows a user to select a file. Once that file is selected, I then want the 2nd piece of code to do its thing which is go through column F and find a country and then create a new sheet copy and paste the data for that country into the new sheet and name that sheet for the country then return to column F and repeat for other countries.

I added a pic as i think it might make it easier. see the end

Both piece of code work fine independently i just need to join them.

1ST piece of code **Select file and msb box **

Sub Click_Me()

    Application.ScreenUpdating = False 'Turns off switching to exported excel file once it gets opened
    Application.DisplayAlerts = False 'Turns off automatic alert messages
    Application.EnableEvents = False '
    Application.AskToUpdateLinks = False 'Turns off the "update links" prompt

    'User prompt, choose HCP file
    MsgBox "Choose TOV file missing consent information"

        'Alternative way to open the file
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = False

     'Assign a number for the selected file
    Dim FileChosen As Integer
    FileChosen = fd.Show
    If FileChosen <> -1 Then
    'Didn't choose anything (clicked on CANCEL)
        MsgBox "No file selected - aborted"
        End 'Ends file fetch and whole sub
    End If


End Sub

2ND piece of code **Separate Column F into other sheets copy and paste and name **

Option Explicit

Sub Filter()
    Dim rCountry As Range, helpCol As Range

    With Worksheets("CountryList") '<--| 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).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

enter image description here

Upvotes: 0

Views: 72

Answers (1)

Arun Thomas
Arun Thomas

Reputation: 845

If FileChosen <> -1 Then
    MsgBox "No file selected - aborted"
Else
    Call Filter
End If

Upvotes: 3

Related Questions