VBA to look for an open file

[ummjay]

hi!

I'm having trouble with the below, if someone can please lend some expertise.

I have a macro in 1 file, that needs to open another file (mapping.xlsx) in order to run a vlookup. I then have it copy/paste values after the vlookup is done, then run a pivot table on that.

I tried to add code to to open the file just before the vlookup, but then it doesnt work properly, and then messed up the pivot table.


What I tried to use for the is open code:

'is file open?
Dim location As String
Dim wbk As Workbook

location = "Mapping DB.xlsx"

Set wbk = Workbooks.Open(location)

Here is the larger code, and need to get it in just before the vlookup, then I want to close it after the vlookup is complete.

Sub START()
    Dim NewFFN  As Variant
     Dim LastRow As Long
    NewFFN = Application.GetOpenFilename(Title:="Please Select File")
    If NewFFN = False Then
        MsgBox "Macro Terminated Due to No File Selected"
        Exit Sub
    Else
        Workbooks.Open FileName:=NewFFN
    End If
    Application.Calculation = xlCalculationAutomatic   '<- may not be necessary
    
'insert column
Dim Column As Range
Set Column = Application.Range("C:C")
Column.Insert Shift:=xlShiftToRight, CopyOrigin:=xlFormatFromRightOrBelow

'add name to new column
Range("C1").Value = "Client Type"

'vlookup
 With ActiveSheet.Activate
        LastRow = Cells(Rows.Count, 1).End(xlUp).Row
        ActiveSheet.Range("C2:C" & LastRow).Formula = "=VLOOKUP(B2,'[Mapping DB.xlsx]Sheet1'!A:E,5,FALSE)"
'copy/paste as values.
      ActiveSheet.Range("C2:C" & LastRow).Copy
      ActiveSheet.Range("C2:C" & LastRow).PasteSpecial Paste:=xlPasteValues
      ActiveSheet.Range("A1:J" & LastRow).EntireColumn.AutoFit
'Clear Clipboard
  Application.CutCopyMode = False
End With

'start vlookup function
'Dim ws As Worksheet
'    Dim LastRow As Long
'    Dim TargetRange As Range
'
'    On Error GoTo MyErrorHandler:
'
'    Set ws = Sheets("Sheet1")
'
'    LastRow = ws.Cells(Rows.Count, "X").End(xlUp).Row
'    Set TargetRange = ws.Range("A1:X" & LastRow)
'
'    result = Application.WorksheetFunction.VLookup(Sheets("Sheet1").Range("C2"), TargetRange, 5, False)
'
'    MsgBox result
'
'MyErrorHandler:
'    If Err.Number = 1004 Then
'      MsgBox "Value not found"
'    End If



'START pivot
 ActiveSheet.UsedRange.Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Sheets(1).UsedRange).CreatePivotTable TableDestination:="", _
        TableName:="Pivot Summary", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
'Insert PIVOT Fields
  With ActiveSheet.PivotTables("Pivot Summary")
    .PivotFields("Client Type").Orientation = xlRowField
    .PivotFields("Client Type").Position = 1
    .PivotFields("Product").Orientation = xlRowField
    .PivotFields("Product").Position = 2
    .PivotFields("Side").Orientation = xlRowField
    .PivotFields("Side").Position = 3
  End With
'Insert Qty column to the data field
  With ActiveSheet.PivotTables("Pivot Summary").PivotFields("Volume")
    .Orientation = xlDataField
    .Position = 1
  .NumberFormat = "#,##0;(#,##0)"

  ActiveWorkbook.RefreshAll
  End With
  
Application.DisplayAlerts = True
Application.ScreenUpdating = True
  
End Sub

 

[NateSC]

Here is some code I use to open a file. It could probably be simplified, but it is fast enough for my purposes. I have included my exact code because I know it works in my case. Feel free to canabilize what you need. In general, I think you have to open the file first and then Set your workbook/worksheet variable (but I could be wrong):

Dim PWS As Worksheet

' Open the plant.xlsx file if it isn't already open
    If IsFileOpen(ActiveWorkbook.Path & "\plant.xlsx") = False Then
        Workbooks.Open filename:=ActiveWorkbook.Path & "\plant.xlsx"
        Workbooks("plant.xlsx").Worksheets("Sheet1").Activate
        Workbooks("plant.xlsx").Worksheets("Sheet1").Range("A1").Select
    Else
        Workbooks("plant.xlsx").Worksheets("Sheet1").Activate
        Workbooks("plant.xlsx").Worksheets("Sheet1").Range("A1").Select
    End If
    
    ' Create a filename with the current date
    MyFileName = "Plant " & MyDate & ".xlsx"
    
    ' Save it with the current date in the name
    ActiveWorkbook.SaveAs filename:= _
        ActiveWorkbook.Path & "\" & MyFileName, FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    
    Sheets(1).Name = "Data"
    
    ' Update PWS
    Set PWS = Workbooks(MyFileName).Worksheets("Data")