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" wrote:
> 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
>
|
Similar Threads
