Amend Macro to limit Selection in C:\My Documents to Vat.*.xlsm

[howard]

I have code below that browses to C:\My documents and allows a user to select a workbook. The Data copies D2 from last sheet and pastes this in A1 on sheet "imported Data" It thencopies AB2 to AD10 and pastes this in A2 onwards on sheet "Imported Data"

I need my code amended to limit the browsing to Vat.*.xlsm within C:\My Documents, which my code is not doing

Kindly amend my code accordingly

Sub ImportData()
    Dim SourceFolder As String
    Dim SourceFile As String
    Dim ws As Worksheet
    Dim LastSheet As Worksheet
    Dim DestRange As Range

    ' Set the source folder
    SourceFolder = "C:\My Documents"

    ' Use FileDialog to select the source file with filters
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select a Vat* File"
        .InitialFileName = SourceFolder
        .Filters.Clear
        .Filters.Add "Excel Macro-Enabled Files", "*.xlsm"
        .FilterIndex = 1
        If .Show = -1 Then
            SourceFile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ' Check if the file name contains "Vat" and ends with ".xlsm"
    If InStr(1, SourceFile, "Vat") > 0 And Right(SourceFile, 5) = ".xlsm" Then
        ' Open the source workbook
        Workbooks.Open SourceFile
        Set LastSheet = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        
        ' Copy D2 from the last sheet to "Imported Data"
        LastSheet.Range("D2").Copy
        ThisWorkbook.Sheets("Imported Data").Range("A1").PasteSpecial xlValues
        ThisWorkbook.Sheets("Imported Data").Range("A1").PasteSpecial xlPasteFormats
        
        ' Copy AB2 to AD10 from the last sheet to "Imported Data"
        LastSheet.Range("AB2:AD10").Copy
        Set DestRange = ThisWorkbook.Sheets("Imported Data").Range("A2")
        DestRange.PasteSpecial xlValues
        DestRange.PasteSpecial xlPasteFormats
        
        ' Close the source workbook without saving
        ActiveWorkbook.Close SaveChanges:=False
    Else
        MsgBox "Selected file does not match the criteria (Vat*.xlsm)."
    End If
End Sub

 

[NdNoviceHlp]

Hi Howard. I think it should just be...

If InStr(SourceFile, "Vat")  And Right(SourceFile, 5) = ".xlsm" Then

You may want to trial...

Msgbox Sourcefile & "   "  & Sourcefile.name

because it maybe...

If InStr(SourceFile.Name, "Vat")  And Right(SourceFile.Name, 5) = ".xlsm" Then

Also, your code opens the sourcefile and then refers to it as the active workbook which is correct but it would be much better to refer to the opened wb as ...

 Workbooks(sourcefile.name)

So XL (and the code reader/user) can distinguish it from ThisWorkbook. HTH. Dave

 

[howard]

Thanks for the help, but when browsing to C:\My Documents , the file names are not limited to starting with Vat

 

[NdNoviceHlp]

When using the Instr function as posted, it equates to either True if anywhere in the name the search word is found OR False if not found. I'm not sure that it produces any different result than how you used it. I suspect it's actually the .Name part that may help. Trial the msgbox before that line of code. Dave

 

[howard]

Thanks for your input

I get invalid qualifier

  MsgBox SourceFile & "   " & SourceFile.Name

See my full code

 Sub ImportData()
    Dim SourceFolder As String
    Dim SourceFile As String
    Dim ws As Worksheet
    Dim LastSheet As Worksheet
    Dim DestRange As Range

    ' Set the source folder
    SourceFolder = "C:\My Documents"
 
    ' Use FileDialog to select the source file with filters
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select a Vat* File"
        .InitialFileName = SourceFolder
        .Filters.Clear
        .Filters.Add "Excel Macro-Enabled Files", "*.xlsm"
        .FilterIndex = 1
        If .Show = -1 Then
            SourceFile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ' Check if the file name contains "Vat" and ends with ".xlsm"
    MsgBox SourceFile & "   " & SourceFile.Name
    If InStr(SourceFile.Name, "Vat") And Right(SourceFile.Name, 5) = ".xlsm" Then
    'If InStr(SourceFile, "Vat") And Right(SourceFile, 5) = ".xlsm" Then
   ' If InStr(1, SourceFile, "Vat") > 0 And Right(SourceFile, 5) = ".xlsm" Then
        ' Open the source workbook
       ' Workbooks.Open SourceFile
        Workbooks (SourceFile.Name)
        Set LastSheet = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        
        ' Copy D2 from the last sheet to "Imported Data"
        LastSheet.Range("D2").Copy
        ThisWorkbook.Sheets("Imported Data").Range("A1").PasteSpecial xlValues
        ThisWorkbook.Sheets("Imported Data").Range("A1").PasteSpecial xlPasteFormats
        
        ' Copy AB2 to AD10 from the last sheet to "Imported Data"
        LastSheet.Range("AB2:AD10").Copy
        Set DestRange = ThisWorkbook.Sheets("Imported Data").Range("A2")
        DestRange.PasteSpecial xlValues
        DestRange.PasteSpecial xlPasteFormats
        
        ' Close the source workbook without saving
        ActiveWorkbook.Close SaveChanges:=False
    Else
        MsgBox "Selected file does not match the criteria (Vat*.xlsm)."
    End If
End Sub

 

[NdNoviceHlp]

My bad. Sourcefile is dimmed as a string and has no name property hence the error. I did some testing and as far as I can tell, your original code (and my initial offering) is correct. Trial just the message box without the .Name part before the check code and see what's wrong. Dave

 

[howard]

Hi Dave

Thanks for all your input

I amended my code as follows and it works perfectly

 Sub ImportData()
    Dim ws As Worksheet
    Dim DestRange As Range
    Dim SourceFile As String
    Dim LastSheet As Worksheet

    With Application
        .ScreenUpdating = False
    End With

    Set ws = ThisWorkbook.Sheets("Imported Data")
    ThisWorkbook.Activate

    ' Create a FileDialog object
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    fd.InitialFileName = "C:\My Documents\Vat*.xlsm"
    fd.Filters.Clear
    MsgBox "Select the Current Financial Year Vat Report"

    With fd
        .Filters.Add "XLSM Files", "*.xlsm"
        .Title = "Select XLSM file"
        .AllowMultiSelect = False
        If .Show = -1 Then
            SourceFile = fd.SelectedItems(1)
            If Not SourceFile Like "C:\My Documents\Vat*.xlsm" Then
                MsgBox "Selected file does not match the required criteria (Vat*.xlsm)."
                Exit Sub
            End If
        Else
            Exit Sub
        End If
    End With

    Debug.Print SourceFile

    ' Open the source workbook
    Workbooks.Open SourceFile
    Set LastSheet = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

    ' Copy D2 from the last sheet to "Imported Data"
    LastSheet.Range("D2").Copy
    ws.Range("A1").PasteSpecial xlValues
    ws.Range("A1").PasteSpecial xlPasteFormats

    ' Copy AB2 to AD10 from the last sheet to "Imported Data"
    LastSheet.Range("AB2:AD10").Copy
    Set DestRange = ws.Range("A2")
    DestRange.PasteSpecial xlValues
    DestRange.PasteSpecial xlPasteFormats

    ' Close the source workbook without saving
    ActiveWorkbook.Close SaveChanges:=False

    With Application
        .ScreenUpdating = True
    End With
End Sub

 

[NdNoviceHlp]

Thanks howard for posting your outcome. Apologies for not providing much assistance. Dave

 

[howard]

Only a pleasure Dave. I appreciate whatever assistance I get. Its wonderful that so many people like you are willing to give up their free time to help others

I have learnt a great deal from this and other forums