Option Explicit

Sub ImportInventoryData()
Dim FS As FileSearch
Dim FilePath, jane As String, FileSpec As String
Dim i As Integer

' Select directory:
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path & "\"
.Title = "Select the Directory for Inventory Files to Import:"
.Show

If .SelectedItems.Count = 0 Then
MsgBox "Cancelled - No Directory Selected"
FilePath = ""
FileSpec = ""
Exit Sub

Else
FilePath = .SelectedItems(1)
FileSpec = "*.dat"
End If
End With

' Create a FileSearch object:
Set FS = Application.FileSearch
With FS
.LookIn = FilePath
.Filename = FileSpec
.Execute

' Exit if no files are found
If .FoundFiles.Count = 0 Then
MsgBox "No files were found at:'" & vbCrLf & FilePath & "'"
Exit Sub
End If
End With

' Import Inventory data for each *.dat file found:
Dim FName As String, UnitName As String, Sep As String
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim FileCode As String

Application.Cursor = xlWait
Application.ScreenUpdating = False

For i = 1 To FS.FoundFiles.Count
FName = FS.FoundFiles(i)

' Application.ScreenUpdating = True
Application.StatusBar = "Processing Dat File: " & FName
' Application.ScreenUpdating = False

Sep = Chr(9)

Workbooks.Open Filename:=ThisWorkbook.Path & "\Inventory Template.xls"
Sheets("Inventory Data").Select
Range("A2").Select

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row - 1

Open FName For Input Access Read As #1

Do While Not EOF(1)
Line Input #1, WholeLine
If RowNdx 1 Then
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
Do While NextPos = 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = Replace(TempVal, Chr(34), "")
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Loop
End If
RowNdx = RowNdx + 1
Loop
Range("A2").Select
Close #1

' Resize columns:
Selection.CurrentRegion.Select
Selection.Columns.EntireColumn.AutoFit
Range("A2").Select

Sheets("Inventory Data").Range("A1").CurrentRegion.Name = "DataRange"

' Refresh Pivot Tables (only need to refresh first pivot table - others
use it as source)
Sheets("By Vendor").PivotTables(1).PivotCache.Refresh

' Save data in template
If Len(Dir(FilePath & "\Output", vbDirectory)) = 0 Then
MkDir FilePath & "\Output"
End If

FileCode = Mid(FName, Len(FilePath) + 1, Len(FName) - Len(FilePath) - 4)
If ThisWorkbook.Worksheets("Macro Data").Range("C:C").Find(FileCode,
LookAt:=xlPart) Is Nothing Then
UnitName = FileCode
Else
UnitName = Application.WorksheetFunction.VLookup(FileCode, _
ThisWorkbook.Worksheets("Macro Data").Range("C:D"), 2, 0)
End If
jane = FilePath & "\Output\" & UnitName & " - " & _
Format(Workbooks("Inventory Macro.xls").Worksheets("Macro
Data").Range("a2"), "MM-YY")
' it's here ----------------------------V
ActiveWorkbook.SaveAs Filename:=FilePath & "Output\" & UnitName & " - "
& _
Format(Workbooks("Inventory Macro.xls").Worksheets("Macro
Data").Range("a2"), "MM-YY"), _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Next i

ErrorHandler:
If Err < 0 Then MsgBox "Import Process Aborted"

Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.StatusBar = False
On Error GoTo 0
End Sub

I cannot find anything in this code that refers to a pivot field. It does
update the pivot cache. Updating the pivot cache may cause the pivot tables
to recalc. I am guessing the problem lies in one of the pivot tables rather
than in this code.

Tom

"SHAWTY721" wrote:

Option Explicit

Sub ImportInventoryData()
Dim FS As FileSearch
Dim FilePath, jane As String, FileSpec As String
Dim i As Integer

' Select directory:
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path & "\"
.Title = "Select the Directory for Inventory Files to Import:"
.Show

If .SelectedItems.Count = 0 Then
MsgBox "Cancelled - No Directory Selected"
FilePath = ""
FileSpec = ""
Exit Sub

Else
FilePath = .SelectedItems(1)
FileSpec = "*.dat"
End If
End With

' Create a FileSearch object:
Set FS = Application.FileSearch
With FS
.LookIn = FilePath
.Filename = FileSpec
.Execute

' Exit if no files are found
If .FoundFiles.Count = 0 Then
MsgBox "No files were found at:'" & vbCrLf & FilePath & "'"
Exit Sub
End If
End With

' Import Inventory data for each *.dat file found:
Dim FName As String, UnitName As String, Sep As String
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim FileCode As String

Application.Cursor = xlWait
Application.ScreenUpdating = False

For i = 1 To FS.FoundFiles.Count
FName = FS.FoundFiles(i)

' Application.ScreenUpdating = True
Application.StatusBar = "Processing Dat File: " & FName
' Application.ScreenUpdating = False

Sep = Chr(9)

Workbooks.Open Filename:=ThisWorkbook.Path & "\Inventory Template.xls"
Sheets("Inventory Data").Select
Range("A2").Select

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row - 1

Open FName For Input Access Read As #1

Do While Not EOF(1)
Line Input #1, WholeLine
If RowNdx 1 Then
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
Do While NextPos = 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = Replace(TempVal, Chr(34), "")
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Loop
End If
RowNdx = RowNdx + 1
Loop
Range("A2").Select
Close #1

' Resize columns:
Selection.CurrentRegion.Select
Selection.Columns.EntireColumn.AutoFit
Range("A2").Select

Sheets("Inventory Data").Range("A1").CurrentRegion.Name = "DataRange"

' Refresh Pivot Tables (only need to refresh first pivot table - others
use it as source)
Sheets("By Vendor").PivotTables(1).PivotCache.Refresh

' Save data in template
If Len(Dir(FilePath & "\Output", vbDirectory)) = 0 Then
MkDir FilePath & "\Output"
End If

FileCode = Mid(FName, Len(FilePath) + 1, Len(FName) - Len(FilePath) - 4)
If ThisWorkbook.Worksheets("Macro Data").Range("C:C").Find(FileCode,
LookAt:=xlPart) Is Nothing Then
UnitName = FileCode
Else
UnitName = Application.WorksheetFunction.VLookup(FileCode, _
ThisWorkbook.Worksheets("Macro Data").Range("C:D"), 2, 0)
End If
jane = FilePath & "\Output\" & UnitName & " - " & _
Format(Workbooks("Inventory Macro.xls").Worksheets("Macro
Data").Range("a2"), "MM-YY")
' it's here ----------------------------V
ActiveWorkbook.SaveAs Filename:=FilePath & "Output\" & UnitName & " - "
& _
Format(Workbooks("Inventory Macro.xls").Worksheets("Macro
Data").Range("a2"), "MM-YY"), _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Next i

ErrorHandler:
If Err < 0 Then MsgBox "Import Process Aborted"

Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.StatusBar = False
On Error GoTo 0
End Sub