Unstable Code

Hi All,

Pasted below is the VBA code l have writen to copy and paste a range to
another workbook (MicawberXLdb.xls) in which one sheet of several will form
a database from which a csv file will be created depending on criteria
selected.
Approx 40 workbooks will feed the database sheet.

You will see that the Sub uses a Function called LastRow. The code in the
function which has been "commented out" worked however if data was deleted
from the database it always found the last row that did have data in it
before the deletion ! I then replaced the code with what you can see and
although it works it sometimes returns an error message if its run several
times. The original code also had the same problem.

Can anybody tell me why this code is unstable ?

All contributions gratefully received.

Sub exporttoMED()
'Exports the FULL CAB PROFILED outputs to the MicawberXLdb.xls file.
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim WBP As String 'Added by MB

WBP = ThisWorkbook.Path
Application.ScreenUpdating = False
If bIsBookOpen("MicawberXLdb.xls") Then
Set destWB = Workbooks("MicawberXLdb.xls")
Else
Set destWB = Workbooks.Open(WBP & "\MicawberXLdb.xls")
End If
Lr = LastRow(destWB.Worksheets("Full CAB Database")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Full CAB
Profiled").Range("A5:S44")
Set destrange = destWB.Worksheets("Full CAB Database").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
ThisWorkbook.Activate
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
sh.Range("A1").Activate
LastRow = ActiveCell.End(xlDown).Row

'Original code
' LastRow = sh.Cells.Find(What:="*", _
' After:=sh.Range("A1"), _
' Lookat:=xlPart, _
' LookIn:=xlFormulas, _
' SearchOrder:=xlByRows, _
' SearchDirection:=xlPrevious, _
' MatchCase:=False).Row
On Error GoTo 0
End Function

I don't see how the commented out code would ever be unstable - particulary
no instability based on running it more than once (unless you consumed all
the rows).

the uncommented code is dependent on sh being the activesheet. Given that
dependency it is possible that it would sometimes fail. If MicawberXLdb.xls
is already open, there is nothing in your code that would insure it is the
activeworkbook and Full CAB Database the activesheet.


--
Regards,
Tom Ogilvy


"Michael Beckinsale" <[email protected]> wrote in message
news:[email protected]...
> Hi All,
>
> Pasted below is the VBA code l have writen to copy and paste a range to
> another workbook (MicawberXLdb.xls) in which one sheet of several will
form
> a database from which a csv file will be created depending on criteria
> selected.
> Approx 40 workbooks will feed the database sheet.
>
> You will see that the Sub uses a Function called LastRow. The code in the
> function which has been "commented out" worked however if data was deleted
> from the database it always found the last row that did have data in it
> before the deletion ! I then replaced the code with what you can see and
> although it works it sometimes returns an error message if its run several
> times. The original code also had the same problem.
>
> Can anybody tell me why this code is unstable ?
>
> All contributions gratefully received.
>
> Sub exporttoMED()
> 'Exports the FULL CAB PROFILED outputs to the MicawberXLdb.xls file.
> Dim sourceRange As Range
> Dim destrange As Range
> Dim destWB As Workbook
> Dim Lr As Long
> Dim WBP As String 'Added by MB
>
> WBP = ThisWorkbook.Path
> Application.ScreenUpdating = False
> If bIsBookOpen("MicawberXLdb.xls") Then
> Set destWB = Workbooks("MicawberXLdb.xls")
> Else
> Set destWB = Workbooks.Open(WBP & "\MicawberXLdb.xls")
> End If
> Lr = LastRow(destWB.Worksheets("Full CAB Database")) + 1
> Set sourceRange = ThisWorkbook.Worksheets("Full CAB
> Profiled").Range("A5:S44")
> Set destrange = destWB.Worksheets("Full CAB Database").Range("A" & Lr)
> sourceRange.Copy
> destrange.PasteSpecial xlPasteValues, , False, False
> Application.CutCopyMode = False
> ThisWorkbook.Activate
> End Sub
>
> Function LastRow(sh As Worksheet)
> On Error Resume Next
> sh.Range("A1").Activate
> LastRow = ActiveCell.End(xlDown).Row
>
> 'Original code
> ' LastRow = sh.Cells.Find(What:="*", _
> ' After:=sh.Range("A1"), _
> ' Lookat:=xlPart, _
> ' LookIn:=xlFormulas, _
> ' SearchOrder:=xlByRows, _
> ' SearchDirection:=xlPrevious, _
> ' MatchCase:=False).Row
> On Error GoTo 0
> End Function
>
>

Michael:

Someone might have an answer for your specific situation, but I too have
noticed that sometimes VBA will go unstable. Something works fine for a
while and then just stops. I don't know why it happens, but I find that
shutting down excel and restarting it from scratch solves the problem.

Not a proper fix I realize, but just to let you know that you're not the
only one who has seen this.

MARTY

"Michael Beckinsale" wrote:

> Hi All,
>
> Pasted below is the VBA code l have writen to copy and paste a range to
> another workbook (MicawberXLdb.xls) in which one sheet of several will form
> a database from which a csv file will be created depending on criteria
> selected.
> Approx 40 workbooks will feed the database sheet.
>
> You will see that the Sub uses a Function called LastRow. The code in the
> function which has been "commented out" worked however if data was deleted
> from the database it always found the last row that did have data in it
> before the deletion ! I then replaced the code with what you can see and
> although it works it sometimes returns an error message if its run several
> times. The original code also had the same problem.
>
> Can anybody tell me why this code is unstable ?
>
> All contributions gratefully received.
>
> Sub exporttoMED()
> 'Exports the FULL CAB PROFILED outputs to the MicawberXLdb.xls file.
> Dim sourceRange As Range
> Dim destrange As Range
> Dim destWB As Workbook
> Dim Lr As Long
> Dim WBP As String 'Added by MB
>
> WBP = ThisWorkbook.Path
> Application.ScreenUpdating = False
> If bIsBookOpen("MicawberXLdb.xls") Then
> Set destWB = Workbooks("MicawberXLdb.xls")
> Else
> Set destWB = Workbooks.Open(WBP & "\MicawberXLdb.xls")
> End If
> Lr = LastRow(destWB.Worksheets("Full CAB Database")) + 1
> Set sourceRange = ThisWorkbook.Worksheets("Full CAB
> Profiled").Range("A5:S44")
> Set destrange = destWB.Worksheets("Full CAB Database").Range("A" & Lr)
> sourceRange.Copy
> destrange.PasteSpecial xlPasteValues, , False, False
> Application.CutCopyMode = False
> ThisWorkbook.Activate
> End Sub
>
> Function LastRow(sh As Worksheet)
> On Error Resume Next
> sh.Range("A1").Activate
> LastRow = ActiveCell.End(xlDown).Row
>
> 'Original code
> ' LastRow = sh.Cells.Find(What:="*", _
> ' After:=sh.Range("A1"), _
> ' Lookat:=xlPart, _
> ' LookIn:=xlFormulas, _
> ' SearchOrder:=xlByRows, _
> ' SearchDirection:=xlPrevious, _
> ' MatchCase:=False).Row
> On Error GoTo 0
> End Function
>
>
>