Nested Arrays - I think

[Guest]

I can't get my brain around this and need some help on what direction to go. I am using Excel2002 and windowsXP. Here is what I have

Sub CreateIDFiles(
Application.ScreenUpdating = Fals
Application.DisplayAlerts = Fals
Dim CreateFiles As Strin
Dim sh As Workshee
Dim i As Lon
Dim cLastRow As Lon

Sheets("IDList").Selec
Set sh = ActiveWorkbook.ActiveShee

cLastRow = Cells(Rows.Count, "B").End(xlUp).Ro
For i = 1 To cLastRo
CreateFiles Left(sh.Cells(i, "B").Value, Len(sh.Cells(i, "B").Value) -0
Next

End Su

Sub CreateFiles(FileName As String
Dim TestStr As Strin
If Dir(ThisWorkbook.Path & "\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls") = "" The
Workbooks.Ad
Sheets("Sheet2").Selec
ActiveWindow.SelectedSheets.Delet
Sheets("Sheet3").Selec
ActiveWindow.SelectedSheets.Delet
ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls"

Els
Workbooks.Open (ThisWorkbook.Path & "\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls"
End I

'!!!!!HERE IS WHERE I AM LOST!!!
End Su

What this does is go through a list of ID's and either makes a file that is named the same as the ID or it opens the file if it already exists. All of that works fine. Then what I need to do for each of these books is while it is opened, go look in two different folders, open any workbook that is in them (may be one or several), and then copy any data out of each of those into this first workbook that was either opened or created.

I know how to do the search for data by the ID for data and copy the row into this new workbook, what I don't know how to do is open the workbooks that have the data. I am thinking I can use almost this same macro with slight additions to find and open those files to copy data out of them, but I am just a little lost as to how to do this

Any help on what direction to go for this would be great, I think I can handle the code and the code for the copy and paste part, I just don't know how to get the files open and selected to copy the data

Thanks

Jim

 

[Dick Kusleika]

James

Sub CreateFiles(FileName As String)
Dim TestStr As String
If Dir(ThisWorkbook.Path &

"\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls") =
"" Then

Workbooks.Add
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.SaveAs (ThisWorkbook.Path &

"\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls")

Else
Workbooks.Open (ThisWorkbook.Path &

"\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls")

End If

'!!!!!HERE IS WHERE I AM LOST!!!!

Check out the Dir statement. How will know the directories? Once you know
that, you can use something like

Dim sPath as String
Dim Fname as String
Dim wb2 as Workbook

sPath = "C:\MyDocuments\" or whatever your path is

Fname = Dir(sPath & "*.xls")

Do While Len(Fname) > 0
Set wb2 = Workbooks.Open(Fname)
'Do your stuff here
wb2.Close False
Fname = Dir
Loop

That will loop through all the xls files in sPath, open them one at a time.
I called the workbook wb2 because you should create another workbook
variables, wb1, so hold that first file. In your Workbooks.Add or
Workbooks.Open lines in your existing code, change them to

Set wb1 = Workbooks.Add or
Set wb1 = Workbooks.Open (...

That way you'll have an easy way to refer back to it.

End Sub

What this does is go through a list of ID's and either makes a file that

is named the same as the ID or it opens the file if it already exists. All
of that works fine. Then what I need to do for each of these books is while
it is opened, go look in two different folders, open any workbook that is in
them (may be one or several), and then copy any data out of each of those
into this first workbook that was either opened or created.

I know how to do the search for data by the ID for data and copy the row

into this new workbook, what I don't know how to do is open the workbooks
that have the data. I am thinking I can use almost this same macro with
slight additions to find and open those files to copy data out of them, but
I am just a little lost as to how to do this.

Any help on what direction to go for this would be great, I think I can

handle the code and the code for the copy and paste part, I just don't know
how to get the files open and selected to copy the data.

 

[Guest]

Ok, I think I was already down that path with the code that I was working on. But there is a wrinkle. Here is what I have

Sub CreateIDFiles(
Application.ScreenUpdating = Fals
Application.DisplayAlerts = Fals
Dim MyPath As Strin
Dim sh As Workshee
Dim i As Lon
Dim cLastRow As Lon

Sheets("IDList").Selec
Set sh = ActiveWorkbook.ActiveShee

cLastRow = Cells(Rows.Count, "B").End(xlUp).Ro
For i = 1 To cLastRo
CreateFiles Left(sh.Cells(i, "B").Value, Len(sh.Cells(i, "B").Value) - 4
Next

End Su
Sub CreateFiles(FileName As String
Dim TestStr As Strin

If Dir(ThisWorkbook.Path & "\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls") = "" The

Workbooks.Ad
Sheets("Sheet2").Selec
ActiveWindow.SelectedSheets.Delet
Sheets("Sheet3").Selec
ActiveWindow.SelectedSheets.Delet
ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\ProgramData\FileData\StoredData\IndividualReports\Employee" & FileName & ".xls"
Els
Workbooks.Open (ThisWorkbook.Path & "\ProgramData\FileData\StoredData\IndividualReports\Employee" & FileName & ".xls"

End I

Dim LastPasteRow1 As Lon
Dim basebook As Workboo
Dim mybook As Workboo
Dim sourceRange As Rang
Dim destrange As Rang
Dim rnum As Lon
Dim a As Lon
Dim FNames As Strin
Dim SaveDriveDir As Strin
Windows("TIPSData.xls").Activat
SaveDriveDir = CurDi
MyPath = ThisWorkbook.Path & "\ProgramData\FileData\ConvertedData\Monthly\Report2\
ChDrive MyPat
ChDir MyPat
FNames = Dir("*.xls"
MyPath = ThisWorkbook.Path & "\ProgramData\FileData\StoredData\CompressedMonthlyReports\Report2\
ChDrive MyPat
ChDir MyPat
FNames1 = Dir("*.xls"
If Len(FNames) = 0 The
MsgBox "No files in the Directory
ChDrive SaveDriveDi
ChDir SaveDriveDi
Exit Su
End I

Application.ScreenUpdating = Fals
Set basebook = ThisWorkboo
rnum =
Do While FNames <> "
Set mybook = Workbooks.Open(FNames1
With mybook.Worksheets(1
For r = .UsedRange.Rows.Count To 1 Step -

If Range("B" & r).Value = FileName The
Range("A" & r, Range("I" & r)).Selec
Selection.Cop

Windows("Employee" & FileName & ".xls").Activat
LastPasteRow1 = ((Cells(Rows.Count, "A").End(xlUp).Row)
If Range("A" & LastPasteRow1) = "" The
LastPasteRow1 =
Els
LastPasteRow1 = LastPasteRow1 +
End I
Range("A" & LastPasteRow1).Selec
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
:=False, Transpose:=Fals
Windows(FNames1).Activat
Else
End I
Next
End Wit
mybook.Close Fals
FNames = Dir(
Loop
Windows("Employee" & FileName & ".xls").Activat
ActiveWorkbook.Sav
ActiveWorkbook.Clos
End Su

I had played around with this code in the area after all the "Dim". What my issue is, it needs to look in one folder, find the file names, but the files that are to be opened are in another folder, but they have the same names. What this is basically because the first folder lists all the files that have been changed since the last update, but the compressed version of the data in those files that I need is in the other folder, but all the files will have the same name (sorry this is sorta even confusing to me)

Basically how do I modify this to look for file names in one folder (in example the ones buried in the compressed folder), and then open and do all the "stuff" to the files of the same name in another folder (in example the stored data folder)

Any help would be great, I am close but just not quite there.

Thanks,

Jim

----- Dick Kusleika wrote: -----

James

Dim TestStr As String
If Dir(ThisWorkbook.Path &

"\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls") =
"" Then

Workbooks.Add
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.SaveAs (ThisWorkbook.Path &

"\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls")

Workbooks.Open (ThisWorkbook.Path &

"\ProgramData\FileData\StoredData\IndividualReports\" & FileName & ".xls")

End If

Check out the Dir statement. How will know the directories? Once you know
that, you can use something like

Dim sPath as String
Dim Fname as String
Dim wb2 as Workbook

sPath = "C:\MyDocuments\" or whatever your path is

Fname = Dir(sPath & "*.xls")

Do While Len(Fname) > 0
Set wb2 = Workbooks.Open(Fname)
'Do your stuff here
wb2.Close False
Fname = Dir
Loop

That will loop through all the xls files in sPath, open them one at a time.
I called the workbook wb2 because you should create another workbook
variables, wb1, so hold that first file. In your Workbooks.Add or
Workbooks.Open lines in your existing code, change them to

Set wb1 = Workbooks.Add or
Set wb1 = Workbooks.Open (...

That way you'll have an easy way to refer back to it.

End Sub

is named the same as the ID or it opens the file if it already exists. All
of that works fine. Then what I need to do for each of these books is while
it is opened, go look in two different folders, open any workbook that is in
them (may be one or several), and then copy any data out of each of those
into this first workbook that was either opened or created.into this new workbook, what I don't know how to do is open the workbooks
that have the data. I am thinking I can use almost this same macro with
slight additions to find and open those files to copy data out of them, but
I am just a little lost as to how to do this.handle the code and the code for the copy and paste part, I just don't know
how to get the files open and selected to copy the data.

 

[Dick Kusleika]

Jim

The Dir function only returns the filename, not the path. When you open the
workbook, you can prefix it with a different path (different from the path
in which you found it). I ran through the code and made some changes.
Generally, you should avoid Selecting ranges and Activating workbooks and
worksheets. It slows down the code and makes it harder to follow
(especially when you look at it a year later). I've put some comments in
this code so you can follow it, but please ask if you don't understand
something.

Sub CreateIDFiles()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim sh As Worksheet
Dim i As Long
Dim cLastRow As Long

Set sh = ThisWorkbook.Sheets("IDList")

cLastRow = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
For i = 1 To cLastRow
CreateFiles Left(sh.Cells(i, "B").Value, _
Len(sh.Cells(i, "B").Value) - 4)
Next i

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Sub CreateFiles(FileName As String)

Dim TestStr As String
Dim IndPath As String
Dim CompPath As String
Dim ConvPath As String
Dim EEWb As Workbook
Dim EEsh As Worksheet
Dim mybook As Workbook
Dim FNames As String
Dim DestRng As Range
Dim r As Long

'initialize path variables
IndPath = ThisWorkbook.Path & "\ProgramData\FileData\StoredData\" & _
"IndividualReports\"
CompPath = ThisWorkbook.Path & "\ProgramData\FileData\StoredData\" & _
"CompressedMonthlyReports\Report2\"
ConvPath = ThisWorkbook.Path & "\ProgramData\FileData\" & _
"ConvertedData\Monthly\Report2\"

'Create a workbook if it doesn't exist, otherwise open it
If Len(Dir(IndPath & "Employee" & FileName & ".xls")) = 0 Then
Set EEWb = Workbooks.Add

'If sheets exist, delete them
On Error Resume Next
EEWb.Sheets("Sheet2").Delete
EEWb.Sheets("Sheet3").Delete
On Error GoTo 0

'Save new workbook
EEWb.SaveAs IndPath & "Employee" & FileName & ".xls"
Else
Set EEWb = Workbooks.Open(IndPath & "Employee" & FileName & ".xls")
End If

'Create a sheet variable for easy reference
Set EEsh = EEWb.Sheets("Sheet1")

'Find the first xls in ConvertedData
FNames = Dir(ConvPath & "*.xls")

'If no xls found
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"

'If at least one xls found
Else

Application.ScreenUpdating = False

'Loop through the xls in ConvertedData
Do While FNames <> ""

'Open the workbook. Note that path was changed to
'CompressedMonthlyReports
Set mybook = Workbooks.Open(CompPath & FNames)

With mybook.Worksheets(1)

'Loop through column B
For r = .UsedRange.Rows.Count To 1 Step -1

If .Range("B" & r).Value = FileName Then

'Find the last row
Set DestRng = EEsh.Cells(EEsh.Rows.Count,
"A").End(xlUp)

'If the last row isn't empty, move down one row
If Not IsEmpty(DestRng) Then
Set DestRng = DestRng.Offset(1, 0)
End If

'Copy A through I from Compressed workbook
.Range("A" & r, "I" & r).Copy

'Paste special to Employee workbook
DestRng.PasteSpecial xlPasteValues

End If
Next r
End With

'Close the Compressed workbook
mybook.Close False

'Get the next xls from Converted
FNames = Dir()
Loop
End If

'Save and close the Employee workbook
EEWb.Save
EEWb.Close

End Sub

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

I had played around with this code in the area after all the "Dim". What

my issue is, it needs to look in one folder, find the file names, but the
files that are to be opened are in another folder, but they have the same
names. What this is basically because the first folder lists all the files
that have been changed since the last update, but the compressed version of
the data in those files that I need is in the other folder, but all the
files will have the same name (sorry this is sorta even confusing to me).

Basically how do I modify this to look for file names in one folder (in

example the ones buried in the compressed folder), and then open and do all
the "stuff" to the files of the same name in another folder (in example the
stored data folder).