Help please! I'm confusing myself.....

[Ray]

This is a follow-up on an early posting:

http://groups.google.com/group/micr...e1ed6/9644f1f3bd616881?hl=en#9644f1f3bd616881

Interesting .... GooglesGroups says there's FOUR messages on that one,
but I can only see 3 ....

Anyways, I think I'm confusing myself. I'll post my current code
below, but to explain what I want to do:
There are two possible situations - update ALL store data OR only
update some store's data. My current code opens (one at a time) all
workbooks in a specified folder and copy/pastes a specified column
into the summary workbook. This works well (thanks Bernie!).

With scenario two, the user should be able to specify which stores to
update -- all others should remain the same. I've taken Dave's
suggestion and am not using checkboxes. I have my list of stores in
one column and in the next column, the user will choose 'yes' or
'no' (uses validation). If a user marks StoreXXX as 'yes', the code
should ONLY open StoreXXX's file to copy/paste from. Format for the
source_file name is 'Forecast_StoreXXX_pd507.xls' After the macro
runs, all yes/no cells should be reset to 'no'.

Further, there will be an option (above the store numbers) to select
'update all' -- this should fire the macro I already have (code
below).

Could someone please help me to do this? Code optimization on my
existing code is certainly welcome -- a whole lot of learning on this
one already, looking forward to more!

Existing code: [Excel2002 on XP]

Sub FetchStoreData_Click()
Dim MyPath As String, getstore As String, FilesInPath As String
Dim MyFiles() As String, Trange As String, Tcol As Integer
Dim SourceRcount As Long, x As Long, Fnum As Long, total As Long
Dim mybook As Workbook, basebook As Workbook, ws As Workbook, sh
As Workbook
Dim sourceRange As Range, destrange As Range, myC As Range

MyPath = "\\r...\...\"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
basebook.Sheets("Current Store
FCs").Range("C5:AG500").ClearContents 'clear all cells on all
sheets

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
total = Fnum

If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0,
True)

Application.StatusBar = "Now processing File " & Fnum & "
of " & total

' Isolates the store number from the workbook name
getstore = mybook.Sheets("Dashboard").Range("E13").Value
getstore = Format(getstore, "000")

mybook.Sheets("P&L Acct Detail").Unprotect ("busnav")
Set sourceRange = mybook.Sheets("P&L Acct
Detail").Range("J5:J500")

Set myC = basebook.Worksheets("Current Store FCs"). _
Range("3:3").Find(getstore, LookIn:=xlValues,
LookAt:=xlWhole)

If Not myC Is Nothing Then
Tcol = myC.Column
Else
MsgBox getstore & " wasn't found"
' it would be great if the code could NOT put
up a msgbox (as this interrupts the code), just close and go to next
file
' but at the very end, a msgbox could pop up
listing ALL of the files that couldn't be updated
'Other action to take when getstore is not
found
End If

Trange = Cells(5, Tcol).Resize(496, 1).Address

Set destrange = basebook.Sheets("Current Store
FCs").Range(Trange)

destrange.Value = sourceRange.Value

mybook.Close savechanges:=False

Next Fnum
End If

Application.StatusBar = False

MsgBox "Matrix is Updated!"

CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.StatusBar = False

End Sub

Thanks VERY much for your time to help me with this code!
br//ray

 

[Tom Ogilvy]

Dim MyPath as String, fNum as Long, Total as Long
Dim mybook as Workbook, cell as Range
' declare other variables.
MyPath = "C:\whatever\"
Total = Application.Countif(Range("B1:B20"),"yes")
If Total > 0 Then
Fnum = 1
For each cell in Range("A1:A20")
if lcase(cell.offset(0,1)) = "yes" then
Set mybook = Workbooks.Open(MyPath & cell.Value, 0,True)

Application.StatusBar = "Now processing File " & _
Fnum & " of " & total

' Isolates the store number from the workbook name
getstore = mybook.Sheets("Dashboard").Range("E13").Value
getstore = Format(getstore, "000")

mybook.Sheets("P&L Acct Detail").Unprotect ("busnav")
Set sourceRange = mybook.Sheets( _
"P&L Acct Detail").Range("J5:J500")

Set myC = basebook.Worksheets("Current Store FCs"). _
Range("3:3").Find(getstore, _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not myC Is Nothing Then
Tcol = myC.Column
Else
cell.Interior.Colorindex = 3 ' not found
End If

Trange = Cells(5, Tcol).Resize(496, 1).Address

Set destrange = basebook.Sheets( _
"Current Store FCs").Range(Trange)

destrange.Value = sourceRange.Value

mybook.Close savechanges:=False
fNum = fNum + 1

Next Cell
End If

Something along the lines of the above

--
regards,
Tom Ogilvy

This is a follow-up on an early posting:

http://groups.google.com/group/micr...e1ed6/9644f1f3bd616881?hl=en#9644f1f3bd616881

Interesting .... GooglesGroups says there's FOUR messages on that one,
but I can only see 3 ....

Anyways, I think I'm confusing myself. I'll post my current code
below, but to explain what I want to do:
There are two possible situations - update ALL store data OR only
update some store's data. My current code opens (one at a time) all
workbooks in a specified folder and copy/pastes a specified column
into the summary workbook. This works well (thanks Bernie!).

With scenario two, the user should be able to specify which stores to
update -- all others should remain the same. I've taken Dave's
suggestion and am not using checkboxes. I have my list of stores in
one column and in the next column, the user will choose 'yes' or
'no' (uses validation). If a user marks StoreXXX as 'yes', the code
should ONLY open StoreXXX's file to copy/paste from. Format for the
source_file name is 'Forecast_StoreXXX_pd507.xls' After the macro
runs, all yes/no cells should be reset to 'no'.

Further, there will be an option (above the store numbers) to select
'update all' -- this should fire the macro I already have (code
below).

Could someone please help me to do this? Code optimization on my
existing code is certainly welcome -- a whole lot of learning on this
one already, looking forward to more!

Existing code: [Excel2002 on XP]

Sub FetchStoreData_Click()
Dim MyPath As String, getstore As String, FilesInPath As String
Dim MyFiles() As String, Trange As String, Tcol As Integer
Dim SourceRcount As Long, x As Long, Fnum As Long, total As Long
Dim mybook As Workbook, basebook As Workbook, ws As Workbook, sh
As Workbook
Dim sourceRange As Range, destrange As Range, myC As Range

MyPath = "\\r...\...\"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
basebook.Sheets("Current Store
FCs").Range("C5:AG500").ClearContents 'clear all cells on all
sheets

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
total = Fnum

If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0,
True)

Application.StatusBar = "Now processing File " & Fnum & "
of " & total

' Isolates the store number from the workbook name
getstore = mybook.Sheets("Dashboard").Range("E13").Value
getstore = Format(getstore, "000")

mybook.Sheets("P&L Acct Detail").Unprotect ("busnav")
Set sourceRange = mybook.Sheets("P&L Acct
Detail").Range("J5:J500")

Set myC = basebook.Worksheets("Current Store FCs"). _
Range("3:3").Find(getstore, LookIn:=xlValues,
LookAt:=xlWhole)

If Not myC Is Nothing Then
Tcol = myC.Column
Else
MsgBox getstore & " wasn't found"
' it would be great if the code could NOT put
up a msgbox (as this interrupts the code), just close and go to next
file
' but at the very end, a msgbox could pop up
listing ALL of the files that couldn't be updated
'Other action to take when getstore is not
found
End If

Trange = Cells(5, Tcol).Resize(496, 1).Address

Set destrange = basebook.Sheets("Current Store
FCs").Range(Trange)

destrange.Value = sourceRange.Value

mybook.Close savechanges:=False

Next Fnum
End If

Application.StatusBar = False

MsgBox "Matrix is Updated!"

CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.StatusBar = False

End Sub

Thanks VERY much for your time to help me with this code!
br//ray

 

[Dave Peterson]

I have no idea if this works, but it does compile.

Option Explicit
Sub FetchStoreData_Click()
Dim MyPath As String
Dim myStoreWkbk As Workbook
Dim GetStore As String
Dim myCell As Range
Dim myListOfStoresRng As Range
Dim CurFCsWks As Worksheet
Dim SourceRng As Range
Dim DestRng As Range
Dim myGetStoreColRng As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

MyPath = "\\r...\...\"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

With ThisWorkbook
Set CurFCsWks = .Worksheets("Current Store FCs")
'clear columns for new data
CurFCsWks.Range("C5:AG500").ClearContents
'define location of list of files to retrieve
With .Worksheets("ListOfStoresWksNameHere")
'headers in Row 1
'filename in A, Yes/no in B, message returned in C"
Set myListOfStoresRng _
= .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
'clear the messages
myListOfStoresRng.Offset(0, 2).ClearContents
End With

For Each myCell In myListOfStoresRng.Cells
If LCase(myCell.Offset(0, 1).Value) <> "yes" Then
myCell.Offset(0, 2).Value = "Skipped!"
Else
Set myStoreWkbk = Nothing
On Error Resume Next
Set myStoreWkbk = Workbooks.Open _
(Filename:=MyPath & myCell.Value, _
UpdateLinks:=0, ReadOnly:=True)
On Error GoTo 0
If myStoreWkbk Is Nothing Then
myCell.Offset(0, 2).Value = "File Not Found/Opened"
Else
Application.StatusBar _
= "Now processing File " & myCell.Value
' Isolates the store number from the workbook name
GetStore _
= myStoreWkbk.Sheets("Dashboard").Range("E13").Value
GetStore = Format(GetStore, "000")

'do you need to unprotect this sheet?
With myStoreWkbk.Worksheets("P&L Acct Detail")
.Unprotect Password:="busnav"
Set SourceRng = .Range("J5:J500")
End With

Set myGetStoreColRng = CurFCsWks.Rows(3).Find _
(what:=GetStore, _
LookIn:=xlValues, _
LookAt:=xlWhole)

If myGetStoreColRng Is Nothing Then
myCell.Offset(0, 2).Value = "Wasn't found"
Else
myCell.Offset(0, 2).Value _
= "Processed into column: " _
& myGetStoreColRng.Address(0, 0)
'just come down 2 rows from the found cell
Set DestRng = myGetStoreColRng.Offset(2, 0)
'just copy|paste special|values
SourceRng.Copy
DestRng.PasteSpecial Paste:=xlPasteValues
'close the file
myStoreWkbk.Close savechanges:=False
End If
End If
End If
Next myCell
End With

MsgBox "Matrix is Updated!"

CleanUp:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.StatusBar = False
End With

End Sub

This is a follow-up on an early posting:

http://groups.google.com/group/micr...e1ed6/9644f1f3bd616881?hl=en#9644f1f3bd616881

Interesting .... GooglesGroups says there's FOUR messages on that one,
but I can only see 3 ....

Anyways, I think I'm confusing myself. I'll post my current code
below, but to explain what I want to do:
There are two possible situations - update ALL store data OR only
update some store's data. My current code opens (one at a time) all
workbooks in a specified folder and copy/pastes a specified column
into the summary workbook. This works well (thanks Bernie!).

With scenario two, the user should be able to specify which stores to
update -- all others should remain the same. I've taken Dave's
suggestion and am not using checkboxes. I have my list of stores in
one column and in the next column, the user will choose 'yes' or
'no' (uses validation). If a user marks StoreXXX as 'yes', the code
should ONLY open StoreXXX's file to copy/paste from. Format for the
source_file name is 'Forecast_StoreXXX_pd507.xls' After the macro
runs, all yes/no cells should be reset to 'no'.

Further, there will be an option (above the store numbers) to select
'update all' -- this should fire the macro I already have (code
below).

Could someone please help me to do this? Code optimization on my
existing code is certainly welcome -- a whole lot of learning on this
one already, looking forward to more!

Existing code: [Excel2002 on XP]

Sub FetchStoreData_Click()
Dim MyPath As String, getstore As String, FilesInPath As String
Dim MyFiles() As String, Trange As String, Tcol As Integer
Dim SourceRcount As Long, x As Long, Fnum As Long, total As Long
Dim mybook As Workbook, basebook As Workbook, ws As Workbook, sh
As Workbook
Dim sourceRange As Range, destrange As Range, myC As Range

MyPath = "\\r...\...\"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
basebook.Sheets("Current Store
FCs").Range("C5:AG500").ClearContents 'clear all cells on all
sheets

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
total = Fnum

If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0,
True)

Application.StatusBar = "Now processing File " & Fnum & "
of " & total

' Isolates the store number from the workbook name
getstore = mybook.Sheets("Dashboard").Range("E13").Value
getstore = Format(getstore, "000")

mybook.Sheets("P&L Acct Detail").Unprotect ("busnav")
Set sourceRange = mybook.Sheets("P&L Acct
Detail").Range("J5:J500")

Set myC = basebook.Worksheets("Current Store FCs"). _
Range("3:3").Find(getstore, LookIn:=xlValues,
LookAt:=xlWhole)

If Not myC Is Nothing Then
Tcol = myC.Column
Else
MsgBox getstore & " wasn't found"
' it would be great if the code could NOT put
up a msgbox (as this interrupts the code), just close and go to next
file
' but at the very end, a msgbox could pop up
listing ALL of the files that couldn't be updated
'Other action to take when getstore is not
found
End If

Trange = Cells(5, Tcol).Resize(496, 1).Address

Set destrange = basebook.Sheets("Current Store
FCs").Range(Trange)

destrange.Value = sourceRange.Value

mybook.Close savechanges:=False

Next Fnum
End If

Application.StatusBar = False

MsgBox "Matrix is Updated!"

CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.StatusBar = False

End Sub

Thanks VERY much for your time to help me with this code!
br//ray