Help on VBA to open specific file from the given location

[aman2059]

Hi All,
Please let me know if below is possible in VBA code. I have provided the macro below and few edits(if possible) are required in it.

So the first step of the VBA is to open the provided code file.

What I need is –
- I need one button in the excel file, so when I click on this button, box has to appear on the sheet1 and in that box, we enter 4 number code(example – 2345), and press “okay”
- VBA takes this code and open the file which has this code in its name from the given location.
- Also in further steps of VBA, I have to switch between files, so when I switch back to my file, I should be able to do that for the provided code file.
- And in last I need to save the file with provided code in the file name and the current date.

The file name is WELearnersinMandateDataExport_3657.xls. However, "3657" code varies, there are many file with different codes and I need to open specific file at one time.

In the code below - I have written "change is required below" where I suppose changes are required.

I need help to edit this for the above criteria.

Thank you in advance for your help.

Sub alwaysfinal121()

[B]' change is required below[/B]
    Workbooks.Open ("C:\Users\aman.bhardwaj\Desktop\Ideas\Learning process\30th November 2015\raw\WELearnersinMandateDataExport_3657.xls")
    ThisWorkbook.Activate
    Windows("WELearnersinMandateDataExport_3657.xls").Activate
    Sheets("Sheet1").Select
    Rows("1:3").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Sheets("Sheet1").Select
    Selection.AutoFilter
    Range("S1").Select
    Selection.End(xlToRight).Select
    ActiveSheet.Range("$A$1:$AY$4718").AutoFilter Field:=51, Criteria1:=">0", Operator:=xlFilterValues
    Selection.End(xlToLeft).Select
    Columns("R:R").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("R1:S1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "AIL"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "RFL"
    Range("R6").Select
    
        [B]' change is required below[/B]
    Windows("WELearnersinMandateDataExport_3657.xls").Activate
    Sheets("Sheet1").Select

   Call highlightfinal24012016
   
End Sub



Sub Save214012016()
    
    Dim FName As String
    Dim FPath As String
    Dim NewBook As Workbook
    Dim wb2 As Workbook
    
    FPath = "C:\Users\aman.bhardwaj\Desktop\Ideas\Learning process\Master files\testing\saved report"
    [B]' change is required below[/B]
    FName = "WELearnersinMandateDataExport_3657_" & Format(Date, "mmddyyyy") & ".xlsx"
    
    On Error Resume Next
        Set wb2 = Workbooks("WELearnersinMandateDataExport_3657.xls")
    On Error GoTo 0
    If wb2 Is Nothing Then
        [B]' change is required below[/B]
        Set wb2 = Workbooks.Open("C:\Users\aman.bhardwaj\Desktop\Ideas\Learning process\30th November 2015\raw\WELearnersinMandateDataExport_3657.xls")
    End If
    
    wb2.Sheets("Sheet1").Copy
    Set NewBook = ActiveWorkbook
    
    If Dir(FPath & "\" & FName) <> "" Then
        MsgBox "File " & FPath & "\" & FName & " already exists"
    Else
        NewBook.SaveAs Filename:=FPath & "\" & FName
    End If

    MsgBox "File -  " & FName & "  saved to the defined location"
    
    
End Sub

 

[aman2059]

Can anyone please help me on this. Thank you