Macro needed to copy client data

Microsoft Microsoft excel 2007 full vers...
July 1, 2010 at 05:26:00
Specs: Windows XP
Requesting some help with a macro design. Below is a macro created where I have a CSV file that has rows of data for multiple clients. I need to separate This data and move it into client workbooks (creating a new sheet in the workbook for each day).

The problem with this macro is the "row line". There should be a way to call the client's name instead of entering different row numbers each day. I have 27 clients I plan to use for this macro, so re-entering row ranges each day for 27 macros is crazy.

Any help is appreciated.

Sub Client1()
'
' Client Workbook
'
Windows("results.CSV").Activate
Rows("1:6").Select
Selection.Copy
Workbooks.Open Filename:= _
"S:\Location\Client.xls"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Application.CutCopyMode = False
ActiveWorkbook.Save
Range("A2").Select
ActiveWindow.Close
End Sub


See More: Macro needed to copy client data

Report •

#1
July 1, 2010 at 06:01:31
I'll address your actual question later, but first I have to ask this question:

Does this code actually work?

Typically, when you open a workbook, the contents of the clipboard are lost and the Paste method fails.

I tried to set up some workbooks with your example names and the code fails at the ActiveSheet.Paste line because the clipboard is empty.

The only way I could get it to work was to open "S:\Location\Client.xls" before copying Rows(1:6) from the results.csv sheet.

Once I rearranged the code to get it to work, I was also able to condense it since you don't always have to Select or Activate ranges to perform an action on them in VBA.

This worked for me:

Sub Client11()
'
' Client Workbook
'
Workbooks.Open Filename:= "S:\Location\Client.xls"
Workbooks("results.CSV").Sheets(1).Rows("1:6").Copy
'Windows("results.csv.xls").Activate
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Columns("A:H").EntireColumn.AutoFit
Application.CutCopyMode = False
ActiveWorkbook.Close Savechanges = True
Range("A2").Select

End Sub

Now, as for your question, I think we need a little more information before we can help.

I'll hazard a guess and say that Yes, the ranges can be copied based on a client name, but you would need to tell us where that client name is and/or how you plan to pass the client name to the macro (e.g. InputBox, a selected cell, a DropDown list, etc.)

You will also need to tell us how the results sheet is laid out so that we can determine the range of cells covered by a given client's name.

Do you see where I'm coming from?


Report •

#2
July 1, 2010 at 06:19:26
The macro did "work" for another user (same business as mine) although I have not tested it.

The client's name is column B of the macro. Each destination folder is identical to column B entry.

I would think you would have an individual macro for each client. Use F5 entry to enable the macro. End of the macro puts the "A2" as the entry for the next macro.

In essence this is what I would like to happen....CSV is the flat file in order by client. Macro "A" would take all of Client "A" data, move it to the Client "A" destination folder. Remove the data from the CSV file. Data rows in CSV would move up the page. Repeat for each client in order.

Please let me know if you need more info....Thank you


Report •

#3
July 1, 2010 at 07:24:09
Well, before we go modifying the macro as requested, why don't you test it against your files and tell us if it actually works?

There's no sense working on code that doesn't work and I really can't be 100% sure that the modifications I already made will work in your environment.

Single step through the original code (F8) and try 2 things:

After the rows are copied, try to manually Paste the data into any workbook that is already open. It should work

Then F8 down until the code opens the other file and try to do a manual Paste. My guess is that it will fail because opening another workbook clears the clipboard, at least in my experience.

If you can't do a manual Paste, then VBA won't be able to Paste anything either.

I won't mind being told I'm wrong, but I'll be surprised if I am.


Report •

Related Solutions

#4
July 1, 2010 at 07:41:48
Hi,

One way to get the required rows is to ask for the client name (uses inputbox), then to go through the results file row by row and copy rows that contain the client name

As I don't know your Results.csv file structure, I assumed that it contained client names in column A.

The loop through the rows uses the For Each ... Next method which loops through all objects in a collection, in this case all cells in a range.

As two files are in use Results and Client, I try to always qualify which one is being referred to in the code.
As Client.xls is referenced a lot, I used a With ... end with structure
With Workbooks("Client.xls") means that any piece of code starting with a period 'belongs' to this workbook

Note that in most cases in VBA it is not necessary to activate or select items before using them.

' Client Workbook
'
Dim rngCell As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim strClient As String
Dim intSheetNum As Integer
Dim intRow As Integer

'get client name
strClient = InputBox("Enter Client Name", "Copy Client Data")
'quit if nothing entered
If strClient = "" Then Exit Sub

'set start of data in col A of Results.csv file
Set rngStart = Workbooks("Results.csv").Worksheets(1).Range("A1")
'find end of data in col A of Results.csv file
Set rngEnd = Workbooks("Results.csv").Worksheets(1) _
            .Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'open destination file
'the destination file could use the strClient text
'strCFile = strClient & ".xls"
'... Filename:=strCFile
Workbooks.Open Filename:="Client.xls"
With Workbooks("Client.xls")
    'add a new worksheet
    .Sheets.Add After:=Sheets(.Sheets.Count)
    'get the new sheet number
    intSheetNum = .Worksheets.Count
    'find client rows and copy
    For Each rngCell In Workbooks("Results.csv").Worksheets(1) _
                .Range(rngStart, rngEnd)
        If rngCell.Text = strClient Then
            'copy the row if column A contains the client's name
            rngCell.EntireRow.Copy _
                Destination:=.Worksheets(intSheetNum).Range("A1"). _
                Offset(intRow, 0)
            'increment the destination row number
            intRow = intRow + 1
        End If
    Next rngCell
    'resize columns A to H to fit
    .Worksheets(intSheetNum).Columns("A:H").EntireColumn.AutoFit
    Application.CutCopyMode = False
    .Save
    .Worksheets(intSheetNum).Range("A2").Select
    .Close
End With

Hope that you can make use of this.


Regards


Report •

#5
July 1, 2010 at 07:55:35
Thank you for the responses from both of you.

To DerbyDad03 - no the original code does not work in my test file...

Should I consider using a dropdown list as suggested by DerbyDad03 and if so how to construct?

Thank you


Report •

#6
July 1, 2010 at 10:11:34
For Humar:

Thank you for your response. I was working with your code and modified it some and now ask for your input.

The code:


' Client Workbook
'
Dim rngCell As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim strClient As String
Dim intSheetNum As Integer
Dim intRow As Integer

'get client name
strClient = InputBox("Enter Client Name", "Copy Client Data")
'quit if nothing entered
If strClient = "" Then Exit Sub

'set start of data in col B of abn crit.csv file
Set rngStart = Workbooks("abn crit.csv").Worksheets(1).Range("A2")
'find end of data in col B of abn crit.csv file
Set rngEnd = Workbooks("abn crit.csv").Worksheets(1) _
.Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'open destination file
'the destination file could use the strClient text
'strCFile = strClient & ".xls"
'... Filename:=strCFile
Workbooks.Open S:\Harvest Reports\AVAL abn.xls:="AVAL abn.xls"
With Workbooks("AVAL abn.xls")
'add a new worksheet
.Sheets.Add After:=Sheets(.Sheets.Count)
'get the new sheet number
intSheetNum = .Worksheets.Count
'find client rows and copy
For Each rngCell In Workbooks("abn crit.csv").Worksheets(1) _
.Range(rngStart, rngEnd)
If rngCell.Text = strClient Then
'copy the row if column A contains the client's name
rngCell.EntireRow.Copy _
Destination:=.Worksheets(intSheetNum).Range("A2"). _
Offset(intRow, 0)
'increment the destination row number
intRow = intRow + 1
End If
Next rngCell
'resize columns A to H to fit
.Worksheets(intSheetNum).Columns("A:H").EntireColumn.AutoFit
Application.CutCopyMode = False
.Save
.Worksheets(intSheetNum).Range("A2").Select
.Close
End With

1) I use column B for "client"
2) My cell used to start the search is A2
3) I renamed my CSV to the acutal file name I use
4) For the Client's file name I gave you the path, directory and sample file name.

If the code is correct with my changes, I need to create a macro for each client and change the destination file name???

Thank you


Report •

#7
July 1, 2010 at 11:52:31
Hi,

I made a correction to the fileopen line.
I was not quite sure if the file name was: "AVAL abn.xls", or just "abn.xls"
I left it as AVAL abn.xls in the folder named "AVAL"

Workbooks.Open Filename:="S:\Harvest Reports\AVAL\AVAL abn.xls"

As client names are in column B, I made the search range use column B

'set start of data in col B of abn crit.csv file
Set rngStart = Workbooks("abn crit.csv").Worksheets(1).Range("B2")
'find end of data in col B of abn crit.csv file
Set rngEnd = Workbooks("abn crit.csv").Worksheets(1) _
        .Range("B" & CStr(Application.Rows.Count)).End(xlUp)

Now when the comparison is being done:

        If rngCell.Text = strClient Then

it is actually comparing data in column B

I also tidied up the save and close, using one line, as per DerbyDad03's code

    .Close Savechanges:= True

I don't think that the Select line near the end did much, as it was originally applied to the workbook before it was closed, so I have removed it.

Here is the revised code:

' Client Workbook
'
Dim rngCell As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim strClient As String
Dim intSheetNum As Integer
Dim intRow As Integer

'get client name
strClient = InputBox("Enter Client Name", "Copy Client Data")
'quit if nothing entered
If strClient = "" Then Exit Sub

'set start of data in col B of abn crit.csv file
Set rngStart = Workbooks("abn crit.csv").Worksheets(1).Range("A2")
'find end of data in col B of abn crit.csv file
Set rngEnd = Workbooks("abn crit.csv").Worksheets(1) _
        .Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'open destination file
'the destination file could use the strClient text
'strCFile = strClient & ".xls"
'... Filename:=strCFile
Workbooks.Open Filename:="S:\Harvest Reports\AVAL\AVAL abn.xls"
With Workbooks("AVAL abn.xls")
    'add a new worksheet
    .Sheets.Add After:=Sheets(.Sheets.Count)
    'get the new sheet number
    intSheetNum = .Worksheets.Count
    'find client rows and copy
    For Each rngCell In Workbooks("abn crit.csv").Worksheets(1) _
        .Range(rngStart, rngEnd)
        If rngCell.Text = strClient Then
            'copy the row if column A contains the client's name
            rngCell.EntireRow.Copy _
            Destination:=.Worksheets(intSheetNum).Range("A2"). _
            Offset(intRow, 0)
            'increment the destination row number
            intRow = intRow + 1
        End If
    Next rngCell
    'resize columns A to H to fit
    .Worksheets(intSheetNum).Columns("A:H").EntireColumn.AutoFit
    Application.CutCopyMode = False
    .Close Savechanges:= True
End With

As to having to change the destination workbook and having 27 macros, why not have all 27 clients run from this one macro. It makes code management and updating much easier.

The client file you used in this example is called "AVAL abn.xls"
Are there 27 Client files - if so is there a simple relationship between Client name and the client's filename.
If so we can make the filename each time from the name you input.

Alternatively start a new workbook - let's call it ClientFileList.xls
This macro will be saved in that file
and in Sheet1 there will be a list of Client names in column A and a list of client filenames in column B
(If the client files are in different subdirectories, that can be included with a small change to the code).

The advantage of this approach is that all files are updated in one go, and there is no need to write a new macro or change anything if the client list changes. Just add/delete names from the list (but don't leave any empty rows).

Here is code to use a ClientFileList.xls workbook
The code could be attached to a button on Sheet1 as follows:
On Worksheet "Sheet1", create a command button from the Control Toolbox toolbar.
(If this isn't visible, right click on an existing toolbar and check the Control Toolbox).
Select the button Icon and draw a button
Right-click the button and select Command Button - Edit and change the name to 'Update Client Files' or something else suitable.
Right-click the button again and select View Code
In the code window that opens enter this:

Option Explicit

Private Sub CommandButton1_Click()
' Client Workbook
'
Dim rngClFnCell As Range
Dim rngClFnStart As Range
Dim rngClFnEnd As Range
Dim strClFn As String
Dim strClNm As String
Dim rngCell As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim strClient As String
Dim intSheetNum As Integer
Dim intRow As Integer

'set start of client names list
Set rngClFnStart = Workbooks("ClientFileList.xls") _
                .Worksheets("Sheet1").Range("A2")
'find end of client names list
Set rngClFnEnd = Workbooks("ClientFileList.xls") _
                .Worksheets("Sheet1").Range("A" & CStr(Application.Rows.Count)) _
                .End(xlUp)

'set start of data in col B of abn crit.csv file
Set rngStart = Workbooks("abn crit.csv").Worksheets(1).Range("B2")
'find end of data in col B of abn crit.csv file
Set rngEnd = Workbooks("abn crit.csv").Worksheets(1) _
        .Range("B" & CStr(Application.Rows.Count)).End(xlUp)

'loop through all client names
For Each rngClFnCell In Workbooks("ClientFileList.xls") _
                .Worksheets("Sheet1").Range(rngClFnStart, rngClFnEnd)
    'get filename (in column B - so offset by 1 column)
    strClFn = rngClFnCell.Offset(0, 1).Text
    'get client name
    strClNm = rngClFnCell.Text
    
    'open appropriate client file
    Workbooks.Open _
            Filename:="S:\Harvest Reports\AVAL\" & strClFn
    With Workbooks(strClFn)
        'add a new worksheet
        .Sheets.Add After:=Sheets(.Sheets.Count)
        'get the new sheet number
        intSheetNum = .Worksheets.Count
        'reset the row offset counter
        intRow = 0
        'find client rows and copy
        For Each rngCell In Workbooks("abn crit.csv").Worksheets(1) _
            .Range(rngStart, rngEnd)
            If rngCell.Text = strClNm Then
                'copy the row if column B contains the client's name
                rngCell.EntireRow.Copy _
                Destination:=.Worksheets(intSheetNum).Range("A2"). _
                            Offset(intRow, 0)
                'increment the destination row number
                intRow = intRow + 1
            End If
        Next rngCell
        'resize columns A to H to fit
        .Worksheets(intSheetNum).Columns("A:H").EntireColumn.AutoFit
        Application.CutCopyMode = False
        .Close Savechanges:=True
    End With
Next rngClFnCell
End Sub

Note that Private Sub CommandButton1_Click() and End sub will already be present, so don't duplicate them. Option Explicit goes before Private Sub CommandButton1_Click().

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.
Exit design mode (first icon on the Controls Toolbox toolbar).

As changes made by Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

Click the 'Update Client Files' button to run the macro.
(the csv file must be open already)

Regards
PS
When posting code, please enclose it in <pre> and </pre> tags. Use the Pre icon that you can find above the reply box to get the tags. Then use the Preview button and edit, as required in the box below the preview. To preview again, check the 'Check To Show Confirmation Page Again' box and click 'Confirm and see post'
Using the tags keeps the code indented - and easier to follow.


Report •

Ask Question