?
Solved

Microsoft Access (VBA-Updating Code)

Posted on 2011-04-19
23
Medium Priority
?
347 Views
Last Modified: 2012-05-11
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
0
Comment
Question by:ArisaAnsar
  • 12
  • 9
22 Comments
 

Author Comment

by:ArisaAnsar
ID: 35424700
I should add that once the changes are done.  The file should save and close.
0
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35424871
Where is the link to the value that you have to look up ?

is it  Range("clMyLookup") ?
0
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35424928
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 19

Expert Comment

by:Arno Koster
ID: 35424968
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
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35424978
or if the windows.close statement will not work as required, use

workbooks(mydestinationfile).close savechanges:=true
0
 

Author Comment

by:ArisaAnsar
ID: 35425160
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
 

Author Comment

by:ArisaAnsar
ID: 35425366
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
 

Author Comment

by:ArisaAnsar
ID: 35425429
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
 
LVL 19

Accepted Solution

by:
Arno Koster earned 2000 total points
ID: 35425446
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
 

Author Comment

by:ArisaAnsar
ID: 35425528
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
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35425548
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
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35425574
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
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35425597
where have you placed the "process" macro ?

when it is declared as sub or public sub, it should be visible...
0
 

Author Comment

by:ArisaAnsar
ID: 35425645
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
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35425666
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
 

Author Comment

by:ArisaAnsar
ID: 35425815
I'm getting the following:  Compile error.
Argument Not Optional.


Doc8.doc
0
 

Author Comment

by:ArisaAnsar
ID: 35426591
Hi akoster,
Are you able to help?
0
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35430983
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
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35430986
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
 

Author Comment

by:ArisaAnsar
ID: 35773369
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
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35777808
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
 
LVL 50
ID: 36032562
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

864 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question