Thread: Macro possible?
View Single Post
  #5  
Old June 6th, 2004, 08:07 PM
Cuda
external usenet poster
 
Posts: n/a
Default Macro possible?

The following sub will handle multiple postings. Use it like you used the
one that posted one at a time. Run it from a button on your main worksheet
or run it from ToolsMacroMacrosPasteClient.

If you want to save the first sub, paste this one in a different module in
VBA. If you're using a button to run it, change the reference on the button
to this sub. Both this sub and the old sub have the same name so be sure to
set the button to this sub in the new module.

Use this sub like you used the old one except select a range of client IDs
that you wish to post. These client IDs CANNOT be scattered but must be
continguous, that is, one after another in column A.

I don't know why you're having a problem with file names with spaces in
them. I tried the old sub and this one with ten dummy files with names with
spaces and had no problem. If you're typing in the original information to
post, I suspect you may be entering the client ids incorrectly. They must
match the file names exactly.

As before, I haven't tested this extensively so use at your own risk.

Sub PasteClient()

Dim ClientFile As String 'Holds client's file name
Dim CurRange As Range 'Holds current range selected

'In case of an error this will handle it gracefully and give you
'some information.
On Error GoTo ErrorHandler

'Turn screen updating off. You won't see the client file being updated.
Application.ScreenUpdating = False

'Make sure proper worksheet is active. This assumes the
'worksheet is named Sheet1. Adjust as required.
If ActiveCell.Worksheet.Name "Sheet1" Then Exit Sub

'Make sure a cell in column A is selected. This assumes the client
'account number is in column A. Adjust as required.
If Left(ActiveCell.Address(False, False), 1) "A" Then Exit Sub

'Get the current range selected. These are cells in column A and
'are contiguous.
Set CurRange = Selection

'Iterate through each cell in selected range of client IDs in
'column A, selecting each client ID then copying client info,
'opening client file, pasting, closing client file.
For Each c In CurRange
'Select the current client id in selected range
c.Select

'Get the client's file name.
ClientFile = ActiveCell.Text & ".xls"

'Select the client data to be posted. This assumes client data
'spans 6 cells
ActiveCell.Range("A1:F1").Copy

'Open the client file for posting. This assumes the path to the
'1000 client files is in the path "C:\Client\". Adjust as required.
Workbooks.Open Filename:="C:\Client\" & ClientFile

'Assumes the client data will be posted on a worksheet named
'"Sheet1" in the client file just opened. Adjust as required.
Sheets("Sheet1").Select

'Position the cursor in the first cell in the client file. Assumes
'client data will be posted beginning in column A. Adjust as required.
Range("A1").Select

'Find the first empty cell where the current data can be posted.
Do While ActiveCell.Text ""
ActiveCell.Offset(1, 0).Select
'Assumes your Excel sheets have 65536 rows. This prevents running
'off the bottom of the worksheet and causing an error. Adjust as
required.
If ActiveCell.Row 65536 Then Exit Sub
Loop

'Paste the client data into the client worksheet file.
ActiveSheet.Paste

'Cancels the copy mode. Client data can no longer be pasted any where else.
Application.CutCopyMode = False

'Save the client workbook and the posted data just pasted.
ActiveWorkbook.Save

'Close the client workbook.
ActiveWindow.Close

'Get next client data in range selected.
Next c

'Turn screen updating back on.
Application.ScreenUpdating = True

Exit Sub

ErrorHandler:

Select Case Err.Number
Case Is = 1004 'Client file already open or client file does not exist.
There may be
'other things that will cause this error.
'There are several ways to handle this error. I chose to inform the user
then exit
'this sub without any alteration to the client file.
MsgBox "There is a problem with client file: " & ClientFile, vbOKOnly +
vbInformation, "An error has occurred ..."
Case Else 'Catches any unexpected errors.
MsgBox "Error number " & Err.Number & " has occurred", vbOKOnly +
vbInformation, "An error has occurred ..."
End Select


End Sub
"Nimit Mehta" wrote in message
...
I have a folder with about 1000 workbooks.
All contain data of conference customers.
All customers have unique account number.

Account Date TIme Country Rate Minutes
34254 26-Jun 4:45 PM USA 2.5 56

I want to have a macro that will open workbook "34256.xls"
and paste the date,time,country,rate and minutes as above
in the empty cells available, save "34256.xls" and exit
the file.
Is that possible?