Barrie, more help with that code you wrote?

Posted by LoriD on September 14, 2001 5:47 AM

Barrie,
The code you wrote works great! I'd like to tweak it a little more, if it's possible. I'd like to have very little user intervention. Specifically, when it asks for the file to update. (There are over 50 stores to add data to each day.) Each file name is actually the store #. Is there a way to tell it to get the file named whatever store number it's currently filtering?

Posted by Barrie Davidson on September 14, 2001 6:45 AM

Lori, what is the naming convention of the file and where is it located. For example, is the file for store #2 called "C:\2.xls"?

BarrieBarrie Davidson

Posted by LoriD on September 14, 2001 7:08 AM

Barrie,

Here is example; the file for store 2 is C:\Cube Analysis\Store2.xls

Lori

Posted by Barrie Davidson on September 14, 2001 7:22 AM

Lori, here is the code changed to automatically update the files. Please note that I have turned screen updating off for the macro (to speed it up) so you won't see anything happening while the macro is running. At the end of the macro you will receive a message box stating "Copying complete". Test it out (on sample files) and let me know how it works out for you.

Sub Data_Copy_To_File()
' Written by Barrie Davidson

Dim searchValue
Dim searchValueAddress As String
Dim dataFile As String
Dim newFile As String

Application.ScreenUpdating = False
dataFile = ActiveWorkbook.Name
Range("A1", Range("A1").End(xlDown).Address).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range( _
"E1"), Unique:=True
searchValueAddress = "E2"
searchValue = Range("E2").Value
Do Until searchValue = ""
Selection.AutoFilter
Range("A1", Range("C1").End(xlDown).Address).Select
Selection.AutoFilter Field:=1, Criteria1:=searchValue
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Open FileName:="C:\Cube Analysis\Store" & searchValue & ".xls"
If Range("A1").Value &LT;&GT; "" Then
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.EntireRow.Delete
Else
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Range("A1").Select
ActiveWorkbook.Close (True)
Windows(dataFile).Activate
searchValueAddress = Range(searchValueAddress).Offset(1, 0).Address
searchValue = Range(searchValueAddress).Value
Loop
Range("A1", Range("C1").End(xlDown).Address).AutoFilter
Range("E1", searchValueAddress).ClearContents
Application.ScreenUpdating = True
Range("A1").Select
MsgBox ("Copying complete")
End Sub

Regards,
BarrieBarrie Davidson

Posted by LoriD on September 14, 2001 7:37 AM

Barrie,

Thank you
Thank you
Thank you!!!

This works great!

Lori