Data Update Loops between Folders

[u473]

This is a simple case of data save from Current to Previous before
updating with New import data.
I made progress in VBA but I still fumble with Syntax & Loops between
Folders, Workbooks and Worksheets.
I need one more push for 2008. Happy New Year to All.
..
Step 1 : Before importing the new CurrentCostToDate from the Cost
History Folder / Latest Month Data,
I have to save the CurrentCostToDate Field values into the
PreviousCostToDate field Values
of the Active WorkSheet.

Structure of folder to be updated
All Workbooks have this name format : #####-g#

Folder TIC711
Workbook 51693-g0
Worksheet 51693
Workbook 51693-g1
Worksheet 51693
Workbook 61101-g0
Worksheet 61101
Workbook 61101-g2
Worksheet 61101
Workbook 61151-g0
Worksheet 61151
Etc...

Logic : Path : C:\Reports
Input Prompt for Folder name ' TIC711
Loop thru all workbooks in this Folder
if righ(Workbook.name,1)="0" 'Like 61101-g0
Sheets(1).activate 'Only
the first Sheet is to be updated
Retrieve Lastrow
CopyRange H10: H & LastRow 'CurrentCostToDate
Range to be copied
Copy CopyRange.values to P10 'Copy to
PreviousCostToDate Field
End If
Next workbook
..
Separate macro, though I could later combine this second update macro
with the fist one.
Step 2 : Update the CurrentCostToDate values (Range H10:H160),
in the same selected workbooks above,
from Source CostHistory Folder, Latest Month Workbook
thru a Vlookup of CostCode Range

Structure of Source folder VlookedUp to update the current looped
worksheet

Folder CostHistory
Workbook Dec07
Worksheet 51693
Worksheet 61101
Worksheet 61151
Worksheet 61191
........................
Workbook Nov07
Worksheet 51693
Etc...
..
Logic: Source Path : C:\CostHistory
Destin. Path : C:\Reports
Input Prompt for Source workbook name ' Dec07
Input Prompt for Destin. Folder name ' TIC711
Loop thru all workbooks in Destination Folder
if righ(Workbook.name,1)="0" 'Like 61101-g0
Sheets(1).activate ' Only the first Sheet
is to be updated
Retrieve Lastrow in Column A in ActiveSheet
DestinRange : H10: H & LastRow 'Range to be
updated
Find ActiveSheet.Name in Source Workbook worksheets
names
Retrieve SourceLastrow in Column A in found Source
workSheet
SourceRange : H2: H & SourceLastRow
For Each Cell in DestinRange
CostCode in Destination Sheet used in Vlookup
is in Column A
sCostCode in Source sheet used in Vlookup is
in Column A
Current Cell.value =
Vlookup(CostCode,sCostCode,SourceRange).value
Next Cell
End If
Next workbook

 

[Joel]

Not sure if this is exactly right but it is very close. GetOpenFilename can
only select a file (not a folder) so you have to select a file. The code
then searches every file in the same folder.

Sub SaveCurrentCostToDate()

Const MainFolder = "C:\Reports"
'Const MainFolder = "C:\temp\working"

Set fs = CreateObject("Scripting.FileSystemObject")

ChDir (MainFolder)
fileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")

SearchDir = fs.GetParentFolderName(fileToOpen)

First = True
Do
If First = True Then
Filename = Dir(SearchDir & "\*.xls")
Else
Filename = Dir()
End If
If Filename <> "" Then
Workbooks.Open Filename:=Filename
Set HistoryBk = ActiveWorkbook
shtname = Left(Filename, InStr(Filename, "-") - 1)
Set sht = HistoryBk.Sheets(shtname)

Lastrow = sht.Range("H" & Rows.Count).End(xlUp).Row
sht.Range("P10") = sht.Range("H" & Lastrow)

HistoryBk.Close
End If
Loop While Filename <> ""

End Sub
Sub UpdateCurrentCostToDate()

Const MainFolder = "C:\Reports"
Const SourceFolder = "C:\CostHistory"
'Const DestFolder = "C:\temp\working"
'Const SourceFolder = "C:\temp\working\CostHistory"

Set fs = CreateObject("Scripting.FileSystemObject")

ChDir (SourceFolder)
HistoryFile = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
Workbooks.Open Filename:=HistoryFile
Set HistoryBk = ActiveWorkbook
Set HistorySht = HistoryBk.ActiveSheet

ChDir (DestFolder)
fileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")

SearchDir = fs.GetParentFolderName(fileToOpen)

First = True
Do
If First = True Then
Filename = Dir(SearchDir & "\*.xls")
First = False
Else
Filename = Dir()
End If
If Filename <> "" Then
Workbooks.Open Filename:=Filename
Set DestBk = ActiveWorkbook
shtname = Left(Filename, InStr(Filename, "-") - 1)
Set DestSht = DestBk.Sheets(shtname)

Lastrow = DestSht.Range("A" & Rows.Count).End(xlUp).Row
NewRow = Lastrow + 1

Set c = HistorySht.Cells.Find( _
what:=shtname, _
LookIn:=xlValues)

If Not c Is Nothing Then
c.EntireRow.Copy Destination:=DestSht.Rows(NewRow)
Else
MsgBox ("Error: Cannot find item " & shtname)
End If
HistoryBk.Close
End If
Loop While Filename <> ""

End Sub

 

[u473]

Thank you. I will put it to test.