Styjun

i have a vba code in one excel which reads data from many other excel at a specific location, but data gets vanished on external excel close

below gives the code which affects the collection after the line

Workbooks(fileName).Save
Workbooks(fileName).Close

Code:

Sub filefindermacro()
 Dim directory As String
 Dim fileName As String
 Dim sheet As Worksheet
 Dim i As Integer
 Dim j As Integer
 Dim datecollection As New Collection
 Dim majorcategory As New Collection
 Dim projectname As New Collection
 Dim partname As New Collection
 Dim username As New Collection
 Dim designerchecker As New Collection
 Dim fpactualhours As New Collection
 Dim ractualhours As New Collection
 Dim currentstatus As New Collection
 Dim softwareused As New Collection
 Application.ScreenUpdating = False
 directory = "D:camUserExcel"
 fileName = Dir(directory & "*.xl??")

 Set projectname = New Collection

 Do While fileName <> ""
 i = i + 1
 j = 2
 Workbooks.Open (directory & fileName)
 For Each sheet In Workbooks(fileName).Worksheets
 If sheet.Name = "HAI" Then
 Dim counter
 counter = sheet.UsedRange.Rows.Count
 For i = 3 To counter
 datecollection.Add (sheet.Cells(i, 1))
 majorcategory.Add (sheet.Cells(i, 2))
 projectname.Add (sheet.Cells(i, 3))
 partname.Add (sheet.Cells(i, 4))
 username.Add (sheet.Cells(i, 5))
 designerchecker.Add (sheet.Cells(i, 6))
 fpactualhours.Add (sheet.Cells(i, 7))
 ractualhours.Add (sheet.Cells(i, 8))
 currentstatus.Add (sheet.Cells(i, 9))
 softwareused.Add (sheet.Cells(i, 10))
 'MsgBox projectname(i - 2)
 Next
 End If
 Next sheet
 **Workbooks(fileName).Save
 Workbooks(fileName).Close**
 fileName = Dir()
 Loop
 Dim projectfile, projname
 projectfile = Replace(ThisWorkbook.Name, ".xlsm", "")
 j = 1

 For i = 1 To projectname.Count
 'MsgBox projectname.Count
 **If projectname.Item(i) = projectfile Then**
 Sheet1.Cells(j, 1) = datecollection(i)
 Sheet1.Cells(j, 2) = majorcategory(i)
 Sheet1.Cells(j, 3) = projectname(i)
 Sheet1.Cells(j, 4) = partname(i)
 Sheet1.Cells(j, 5) = username(i)
 Sheet1.Cells(j, 6) = designerchecker(i)
 Sheet1.Cells(j, 7) = fpactualhours(i)
 Sheet1.Cells(j, 8) = ractualhours(i)
 Sheet1.Cells(j, 9) = currentstatus(i)
 Sheet1.Cells(j, 10) = softwareused(i)
 j = j + 1
 End If
 Next
 Application.ScreenUpdating = True
End Sub

I missed it earlier but here is your problem:

projectname.Add (sheet.Cells(i, 3))

What are you actually adding to the projectname collection when you do this?

You might expect it to be the cell's value (since that's the default property of Range), but you're actually adding a reference to the cell itself, and once you've closed the source workbook, you can no longer access that.

Here's the fix:

 projectname.Add sheet.Cells(i, 3).Value

Another reason never to write code which uses default properties without explicitly including them...

And you don't need the () here.