Macros terminate early

[Pierre]

I have a problem with a couple of macros I've written to
copy cells from one spreadsheet to another. The macros die
a premature death - they just stop running.

In one case, I have individual commands which select each
cell, copies it, selects the new worksheet, and then
pastes it to another specific cell. This runs for about 4-
5 cells, then stops executing, even though there are
several more operations to perform. In the other case, I'm
using a loop to copy multiple cells. It stops before it
hits the limits.

I've run both macros successfully before. Now they're
misbehaving. Any ideas?

 

[mudraker]

It would help us to answer your question if you posted your code

 

[Harald Staff]

Hi Pierre

The only time (but often) I encounter this is when my code has to deal with the invisible
chr(0), ascii code 0, which I believe is an "end of information" flag in many cases. The
code stops without reason and warning if that character's a part of a string or something.

If this is not the case, turn off absolutely all error handling and see if anything
happens.

 

[Pierre]

Mudraker -

Thanks for your response. The code I'm using in the case
of the individual cell copies is below. It's
very "inelegant" - I want to get the basic operation down
before I go back and clean it up.

My application calls for multiple users to fill out weekly
Time Sheets and Status Reports. This code is supposed to
copy individual pieces of information from the prior
version workbook to the next version without the user
having to manually setup up the new workbook. The macro is
run from the new workbook.

----------------------------------------------------------
Sub CopyUserInfo()
'
' CopyUserInfo Macro
' Macro recorded 1/8/2004 by PSM
'
Dim NewWkbk As String
Dim OldWkbk As String
NewWkbk = "TS_SR_v2.xls"
OldWkbk = "TS_SR_v1.1.xls"
'
Sheets("Timesheet").Select 'Initalize new wkbk to
Timesheet
'Check for old wkbk open -
'If open, then Activate
'If not, then Open
If WorkbookIsOpen(OldWkbk) _
Then Windows(OldWkbk).Activate _
Else Workbooks.Open Filename:= _
ThisWorkbook.Path & "\" & OldWkbk

Sheets("Timesheet").Select 'Initialize old wkbk to
Range("D2").Select 'Timesheet and copy name
Selection.Copy
Windows(NewWkbk).Activate
Range("D2").Select
ActiveSheet.Paste

Windows(OldWkbk).Activate 'Copy badge #
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Windows(NewWkbk).Activate
Range("D4").Select
ActiveSheet.Paste

Windows(OldWkbk).Activate 'Copy phone #
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
Windows(NewWkbk).Activate
Range("F5").Select
ActiveSheet.Paste

Windows(OldWkbk).Activate 'Paste old TSPath into
Range("O8").Select 'new sheet, preserve
Application.CutCopyMode = False 'conditional formatting
Selection.Copy
Windows(NewWkbk).Activate
Range("O8").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(OldWkbk).Activate 'Copy hyperlinks
Range("N2:N3").Select
Application.CutCopyMode = False
Selection.Copy
Windows(NewWkbk).Activate
Range("N2:N3").Select
ActiveSheet.Paste

Windows(OldWkbk).Activate 'Copy old TS charge # info
Range("B924").Select
Application.CutCopyMode = False
Selection.Copy
Windows(NewWkbk).Activate
Range("B924").Select
ActiveSheet.Paste


Windows(OldWkbk).Activate 'Paste old AltPath from
Stat Report
Sheets("StatusReport").Select 'as new Local SRPath,
preserve
Range("J4").Select 'conditional formatting
Application.CutCopyMode = False
Selection.Copy

'****** Macro stops here*****************************

Windows(NewWkbk).Activate
Sheets("StatusReport").Select
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Timesheet").Select 'Finished
Range("A1").Select
MsgBox "User Data transferred - Please verify that all
entries are correct"
ActiveWindow.Close


End Sub

 

[Guest]

Mudraker -

Here is a copy of the code which stops in a loop. Again,
not very elegant - more time for that later.

The purpose of this macro is to copy a field of cells from
a sheet on another machine into a specific sheet in a
Master workbook.

I'm using the VBA function for getting data from a closed
file described at J-Walk.com. The calling routine provides
the path and name of the source file.

In the first version I developed, everything works fine. I
can copy data from 5 external workbooks on the network
without a hitch. For some reason, it now process the first
file fine, then stops on the second cell of the second
file. ?????

--------------------------------------------------------
Private Sub GetSRData(filepath, filename, destsheet)
'Sub GetSRData(filepath, filename)
'Ref:

Dim Temp

s = "StatusReport"
a = "A1"

' Turn off the screen update while getting data
Application.ScreenUpdating = False

' Activate the destination worksheet
Sheets(destsheet).Activate

' Get initial cells of the target worksheet through
GetValue
' Error check for no file
If Dir(filepath & filename) = "" Then
Cells(1, 2) = "File Not Found"
Exit Sub
End If

' Error check for incompatible revision
Mstr_Rev = ThisWorkbook.Worksheets("Main").Range("A23")
a = Cells(1, 1).Address
SR_Rev = GetValue(filepath, filename, s, a)
If Mstr_Rev <> SR_Rev Then
Cells(1, 2) = "File Incompatible - Rev Error"
Exit Sub
End If

' Get Name and W/E date - for Rev. 2.0
a = Cells(1, 2).Address
Cells(1, 2) = GetValue(filepath, filename, s, a)
a = Cells(1, 4).Address
Cells(1, 4) = GetValue(filepath, filename, s, a)


' Get remainder of cells
For r = 3 To 53
For c = 1 To 8
a = Cells(r, c).Address
Cells(r, c) = GetValue(filepath, filename, s,
a)
If Cells(r, c) = "0" Then Cells(r, c) = ""
Next c
Next r

' Turn the screen update back on
Application.ScreenUpdating = True

End Sub
---------------------------------------------------------
Private Function GetValue(path, file, sheet, ref)
'Ref: J-Walk "VBA Function to Get a Value From a Closed
File"
'This function operates as a Excel4 (XLM) macro to get
data from a
'closed workbook. It accesses a single cell at a time, as
follows:
' path = path to target file
' file = name of target file
' sheet = name of target sheet
' ref = target cell

'If the file is not found, "File Not Found" is returned as
the cell value.
'It is up to the calling routine to handle this case;
otherwise, all the
'cells will have "File Not Found" in them.

Dim arg As String

' Make sure the file exists
' Add "\" to end of path if not there already
If Right(path, 1) <> "\" Then path = path & "\"

' Dir returns "" if no file found; bail out of routine
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If

' Create the argument for the Excel 4 macro
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)

' Execute the GetValue XLM macro
GetValue = ExecuteExcel4Macro(arg)

End Function

 

[mudraker]

Pierre

As your script process the first book ok and only errors after startin
on the 2nd book It sounds like their is a problem in the 2nd book.

Have you tried removing that book out of the process to see if it wil
continue with the other books

 

[Pierre]

Yes - I changed the flow to skip a book. It terminated at
the same place in the new second book. I tried changing
the data in the cell where it stops (it's just text) with
no effect.