Microsoft Access (VBA-Updating Code)

I need help in tweaking the following code.  I have a master file that includes hundreds of locations.  The VBA code below automatically copies the rows specific to each location onto its own file within a specific folder onto the tab called Destination.
Unfortunately, I have to select a value from a lookup table and run the code before the files are updated.  This means I have to select the value hundreds of time before all the locations files are updated.  Can this code be tweaked so that I run the code once and all the files get updated appropriately?

Sub clExtract()

Dim MyLookup As String, MyDestinationFile As String, MySourceFile As String, MyPath As String

MyLookup = Range("clMyLookup")
'I am using the MyLookup as part of the file name for easy identification
MyDestinationFile = MyLookup & ".xls"
'make sure the following line is spelled exactly as your source file
MySourceFile = "Connect - CSA Engagement Report April 15.xls"
'replace "E:\A Work\SmithBarney\" with your path
MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports\" & MyDestinationFile

    Application.ScreenUpdating = False 'disables screen updating and speeds processing
   
    Workbooks.Open Filename:=MyPath
    Sheets("Destination").Select
    Range("A6").Name = "start"
    'Bookmarks the starting point in the destination file
    Windows(MySourceFile).Activate
    Sheets("Complex").Select
    Range("D6").Select
    Range("D6").Name = "BM" 'Bookmarks the starting point in the start file
   
        Do Until ActiveCell = ""
       
            If ActiveCell = MyLookup Then
                    ActiveCell.EntireRow.Copy
                    Windows(MyDestinationFile).Activate
                    Range("start").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    'Prior range name does not need to be deleted.
                    'The act of creating the same name in a new location destroys the old one.
                    Range("start").Offset(1, 0).Name = "Start"
                    Windows(MySourceFile).Activate
                    Range("BM").Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
                Else
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
            End If
           
        Loop
       
    Range("A1").Select
   
    Application.CutCopyMode = xlCopy 'remoces the dashed boarder from a copied selection
    Application.ScreenUpdating = True 're-enables screen updating
   
    MsgBox "Done", , "Done"
   
End Sub

Connect---CSA-Engagement-Report-.xls
31-WEST-52ND-ST.xls
ArisaAnsarAsked:
Who is Participating?
 
Arno KosterConnect With a Mentor Commented:
sure, that would be

Public Sub clExtract(MyLookup as string)
Dim MyDestinationFile As String, MySourceFile As String, MyPath As String

'I am using the MyLookup as part of the file name for easy identification
MyDestinationFile = MyLookup & ".xls"
'make sure the following line is spelled exactly as your source file
MySourceFile = "Connect - CSA Engagement Report April 15.xls"
'replace "E:\A Work\SmithBarney\" with your path
MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports\" & MyDestinationFile

    Application.ScreenUpdating = False 'disables screen updating and speeds processing
    
    Workbooks.Open Filename:=MyPath
    Sheets("Destination").Select
    Range("A6").Name = "start"
    'Bookmarks the starting point in the destination file
    Windows(MySourceFile).Activate
    Sheets("Complex").Select
    Range("D6").Select
    Range("D6").Name = "BM" 'Bookmarks the starting point in the start file
    
        Do Until ActiveCell = ""
        
If ActiveCell = MyLookup Then
                    ActiveCell.EntireRow.Copy
                    Windows(MyDestinationFile).Activate
                    Range("start").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    'Prior range name does not need to be deleted.
                    'The act of creating the same name in a new location destroys the old one.
                    Range("start").Offset(1, 0).Name = "Start"
                    Windows(MySourceFile).Activate
                    Windows(MyDestinationFile).close savechanges:=true
                    Range("BM").Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
                Else
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
            End If
            
        Loop
        
    Range("A1").Select
    
    Application.CutCopyMode = xlCopy 'remoces the dashed boarder from a copied selection
    Application.ScreenUpdating = True 're-enables screen updating
    
    MsgBox "Done", , "Done"
    
End Sub

Open in new window

0
 
ArisaAnsarAuthor Commented:
I should add that once the changes are done.  The file should save and close.
0
 
Arno KosterCommented:
Where is the link to the value that you have to look up ?

is it  Range("clMyLookup") ?
0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

 
Arno KosterCommented:
if so, you could use something like :

Sub process()

Set lookup_range = Worksheets("shMyLookUp").Range("D2:D" & Worksheets("shMyLookUp").UsedRange.Rows.Count)
For Each Item In lookup_range.Cells
    Debug.Print "Processing " &  Item
    clExtract item
Next Item
End Sub

Open in new window


but then you'll have to update the clExtract subroutine like this :
public sub clExtract(MyLookup as string)
Dim MyDestinationFile As String, MySourceFile As String, MyPath As String

'I am using the MyLookup as part of the file name for easy identification
[...]

Open in new window



0
 
Arno KosterCommented:
for the save and close part :

update

 If ActiveCell = MyLookup Then
                    ActiveCell.EntireRow.Copy
                    Windows(MyDestinationFile).Activate
                    Range("start").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    'Prior range name does not need to be deleted.
                    'The act of creating the same name in a new location destroys the old one.
                    Range("start").Offset(1, 0).Name = "Start"
                    Windows(MySourceFile).Activate
                    Range("BM").Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
                Else
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
            End If


to
 If ActiveCell = MyLookup Then
                    ActiveCell.EntireRow.Copy
                    Windows(MyDestinationFile).Activate
                    Range("start").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    'Prior range name does not need to be deleted.
                    'The act of creating the same name in a new location destroys the old one.
                    Range("start").Offset(1, 0).Name = "Start"
                    Windows(MySourceFile).Activate
                    Windows(MyDestinationFile).close savechanges:=true
                    Range("BM").Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
                Else
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
            End If

Open in new window

0
 
Arno KosterCommented:
or if the windows.close statement will not work as required, use

workbooks(mydestinationfile).close savechanges:=true
0
 
ArisaAnsarAuthor Commented:
Thanks akoster.
The value to the lookup is on the Source File on the tab called ShMyLookup.
Yes, the lookup value is Range("clMyLookup").

Let me try your suggestions and will let you know.
0
 
ArisaAnsarAuthor Commented:
ok- I'm very new to VBA so I cannot understand the first two posts.  Can you combine into the correct codes and send to me, please?

Thank you very much for your help.
0
 
ArisaAnsarAuthor Commented:
This is what I'm coming up with but I'm getting an error message;

Sub process()

Set lookup_range = Worksheets("shMyLookUp").Range("D2:D" & Worksheets("shMyLookUp").UsedRange.Rows.Count)
For Each Item In lookup_range.Cells
    Debug.Print "Processing " & Item
    clExtractItem
Next Item
End Sub

Public Sub clExtract(MyLookup As String)
Dim MyDestinationFile As String, MySourceFile As String, MyPath As String

'I am using the MyLookup as part of the file name for easy identification


Sub clExtractItem()

Dim MyLookup As String, MyDestinationFile As String, MySourceFile As String, MyPath As String

MyLookup = Range("clMyLookup")
'I am using the MyLookup as part of the file name for easy identification
MyDestinationFile = MyLookup & ".xls"
'make sure the following line is spelled exactly as your source file
MySourceFile = "Connect - CSA Engagement Report April 15.xls"
'replace "E:\A Work\SmithBarney\" with your path
MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test\" & MyDestinationFile

    Application.ScreenUpdating = False 'disables screen updating and speeds processing
   
    Workbooks.Open Filename:=MyPath
    Sheets("Destination").Select
    Range("A6").Name = "start"
    'Bookmarks the starting point in the destination file
    Windows(MySourceFile).Activate
    Sheets("Complex").Select
    Range("D6").Select
    Range("D6").Name = "BM" 'Bookmarks the starting point in the start file
   
        Do Until ActiveCell = ""
       
          If ActiveCell = MyLookup Then
                    ActiveCell.EntireRow.Copy
                    Windows(MyDestinationFile).Activate
                    Range("start").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    'Prior range name does not need to be deleted.
                    'The act of creating the same name in a new location destroys the old one.
                    Range("start").Offset(1, 0).Name = "Start"
                    Windows(MySourceFile).Activate
                    Windows(MyDestinationFile).Close savechanges:=True
                    Range("BM").Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
                Else
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
            End If
           
        Loop
       
    Range("A1").Select
   
    Application.CutCopyMode = xlCopy 'remoces the dashed boarder from a copied selection
    Application.ScreenUpdating = True 're-enables screen updating
   
    MsgBox "Done", , "Done"
0
 
ArisaAnsarAuthor Commented:
How do I run it?
Its not listed as one of the available macros?  I'm sorry to keep asking.

I tried adding a differnet name so that it shows up correctly but its not working.
Doc6.doc
0
 
Arno KosterCommented:
You will get an error message on

Public Sub clExtract(MyLookup As String)
Dim MyDestinationFile As String, MySourceFile As String, MyPath As String

'I am using the MyLookup as part of the file name for easy identification


Sub clExtractItem()

because you have started a subrouting (public sub ...) but did not end it (end sub)

It would have worked if you had replaced the original lines instead of adding them.
0
 
Arno KosterCommented:
To start running it, you should be running the "Process" macro.

If you click somewhere in the process macro (eg. on the "Set lookup_range [...]" line) and press F5 (for automatic run) or F8 (for step-by-step run)
0
 
Arno KosterCommented:
where have you placed the "process" macro ?

when it is declared as sub or public sub, it should be visible...
0
 
ArisaAnsarAuthor Commented:
This is the entire code I have but still getting an error message.  Does my file name have to include the words MyLookup?

Sub process()

Set lookup_range = Worksheets("shMyLookUp").Range("D2:D" & Worksheets("shMyLookUp").UsedRange.Rows.Count)
For Each Item In lookup_range.Cells
    Debug.Print "Processing " & Item
    clExtractItem
Next Item
End Sub

Public Sub clExtract(MyLookup As String)
Dim MyDestinationFile As String, MySourceFile As String, MyPath As String

'I am using the MyLookup as part of the file name for easy identification
MyDestinationFile = MyLookup & ".xls"
'make sure the following line is spelled exactly as your source file
MySourceFile = "Connect - CSA Engagement Report April 15.xls"
'replace "E:\A Work\SmithBarney\" with your path
MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test" & MyDestinationFile

    Application.ScreenUpdating = False 'disables screen updating and speeds processing
   
    Workbooks.Open Filename:=MyPath
    Sheets("Destination").Select
    Range("A6").Name = "start"
    'Bookmarks the starting point in the destination file
    Windows(MySourceFile).Activate
    Sheets("Complex").Select
    Range("D6").Select
    Range("D6").Name = "BM" 'Bookmarks the starting point in the start file
   
        Do Until ActiveCell = ""
       
If ActiveCell = MyLookup Then
                    ActiveCell.EntireRow.Copy
                    Windows(MyDestinationFile).Activate
                    Range("start").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    'Prior range name does not need to be deleted.
                    'The act of creating the same name in a new location destroys the old one.
                    Range("start").Offset(1, 0).Name = "Start"
                    Windows(MySourceFile).Activate
                    Windows(MyDestinationFile).Close savechanges:=True
                    Range("BM").Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
                Else
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
            End If
           
        Loop
       
    Range("A1").Select
   
    Application.CutCopyMode = xlCopy 'remoces the dashed boarder from a copied selection
    Application.ScreenUpdating = True 're-enables screen updating
   
    MsgBox "Done", , "Done"
   
End Sub

Doc7.doc
0
 
Arno KosterCommented:
No,

the problem is using a variable (lookup_range), before it has been properly dimensioned.
I did not notice that you use option explicit.

try this :

Public Sub process()
dim lookup_range as range
dim item as variant

Set lookup_range = Worksheets("shMyLookUp").Range("D2:D" & Worksheets("shMyLookUp").UsedRange.Rows.Count)
For Each Item In lookup_range.Cells
    Debug.Print "Processing " & Item
    clExtractItem
Next Item
End Sub

Open in new window

0
 
ArisaAnsarAuthor Commented:
I'm getting the following:  Compile error.
Argument Not Optional.


Doc8.doc
0
 
ArisaAnsarAuthor Commented:
Hi akoster,
Are you able to help?
0
 
Arno KosterCommented:
i am able to help, but around the time of my last post I went home...

the problem is a typo in line 8 of the code in my last post :

clExtractItem

this should have been :

clExtract CStr(Item)

Open in new window


where "clExtract" relates to the function performing the work and "item" gives this function the specific selected value to work with.
because of the option explicit, a variable used in a 'for each' loop is required to have the data type variant or object. Therefor it needs to be converted to a string as required by the clExtract function : thus the CStr(item)
0
 
Arno KosterCommented:
Public Sub process()
Dim lookup_range As Range
Dim item As Variant

Set lookup_range = Worksheets("shMyLookUp").Range("D2:D" & Worksheets("shMyLookUp").UsedRange.Rows.Count)
For Each item In lookup_range.Cells
    Debug.Print "Processing " & item
    clExtract CStr(item)
Next item

End Sub

Open in new window

0
 
ArisaAnsarAuthor Commented:
I cannot get this macro to work for anything.  What am I doing wrong?
Option Explicit
Public Sub clExtractTest(MyLookup As String)
Dim MyDestinationFile As String, MySourceFile As String, MyPath As String

'I am using the MyLookup as part of the file name for easy identification
MyDestinationFile = MyLookup & ".xls"
'make sure the following line is spelled exactly as your source file
MySourceFile = "Connect - CSA Engagement Report 5-15.xls"
'replace "E:\A Work\SmithBarney\" with your path
MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports\Complex Reports Test\" & MyDestinationFile

    Application.ScreenUpdating = False 'disables screen updating and speeds processing
   
    Workbooks.Open Filename:=MyPath
    Sheets("Destination").Select
    Range("A6").Name = "start"
    'Bookmarks the starting point in the destination file
    Windows(MySourceFile).Activate
    Sheets("Complex").Select
    Range("D6").Select
    Range("D6").Name = "BM" 'Bookmarks the starting point in the start file
   
        Do Until ActiveCell = ""
       
If ActiveCell = MyLookup Then
                    ActiveCell.EntireRow.Copy
                    Windows(MyDestinationFile).Activate
                    Range("start").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    'Prior range name does not need to be deleted.
                    'The act of creating the same name in a new location destroys the old one.
                    Range("start").Offset(1, 0).Name = "Start"
                    Windows(MySourceFile).Activate
                    Windows(MyDestinationFile).Close savechanges:=True
                    Range("BM").Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
                Else
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Name = "BM"
            End If
           
        Loop
       
    Range("A1").Select
   
    Application.CutCopyMode = xlCopy 'remoces the dashed boarder from a copied selection
    Application.ScreenUpdating = True 're-enables screen updating
   
    MsgBox "Done", , "Done"
0
 
Arno KosterCommented:
What does not work ? are you getting errors at a specific step or will the macro not run at all ?

as a start I imagine that you didn't copy the "end sub" line after the msgbox "done", otherwise you indeed will not be able to run anything at all.

can you verify that at the workbooks.open line the 'mypath' variable points to an existing file and that this particular file indeed is opened ?
can you verify that it contains the "Destination"  worksheet ?
can you verify that the steps of the do loop are actually processed and not skipped because activecell = "" ?
can you verify that the windows([...]).activate lines do not throw errors ?

you will have to give me a little more detailed information on where you are stuck before I will be able to assist you.
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.