Macro runs in another workbook if you open simultaneously

[Priyanka]

Hi

I have a macro 'Adder' that is scheduled to run every fifteen minutes
on a particular workbook which contains a worksheet called 'Monitor'.
However, if another workbook is opened while this macro is running,
the macro tries to find the sheet Monitor in the other open workbook
and returns a 'subscript out of range error'. How do I prevent this?
Please help. The code is pasted below. Thanks a bunch in advance
Priyanka


Public RunWhen As Double

Public Const cRunIntervalSeconds = 900 ' FIFTEEN minutes

Public Const cRunWhat = "CopyDataMacro" ' the name of the procedure
to run


Dim Sht1RowCount, Sht1ColCount As Long



Public Sub Adder()

Worksheets.Add.Name() = "Sheet2"

'Calculate size of input

Sheets("Monitor").Select

Sht1RowCount = ActiveSheet.UsedRange.Rows.Count

Sht1ColCount = ActiveSheet.UsedRange.Columns.Count




Range(Cells(5, 1), Cells(5, Sht1ColCount)).Select

Range(Cells(5, 1), Cells(5, Sht1ColCount)).Copy




'Initiate Sheet2



'Copy header row from Monitor to initiate

Sheets("Sheet2").Select

Range(Cells(1, 1), Cells(1, Sht1ColCount)).Select

ActiveSheet.Paste

CopyDataMacro

End Sub


Sub StartTimer()

RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)

Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True

End Sub

Sub CopyDataMacro()




'Select data rows from Monitor sheet

Sheets("Monitor").Select

Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Select

Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Copy



'Determine input in Sheet2 sheet

Sheets("Sheet2").Select

Dim LastRow, LastColumn As Long



If WorksheetFunction.CountA(Cells) > 0 Then

'Search for any entry, by searching backwards by Rows.

LastRow = Cells.Find(What:="*", After:=[A1], _

SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious).Row

End If


If WorksheetFunction.CountA(Cells) > 0 Then

'Search for any entry, by searching backwards by Columns.

LastColumn = Cells.Find(What:="*", After:=[A1], _

SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious).Column



End If




'Paste in Sheet2 Sheet

Range(Cells(LastRow + 1, 1), Cells(LastRow + Sht1RowCount - 1,
Sht1ColCount)).Select

Selection.PasteSpecial Paste:=xlValues

Cells(LastRow + 1, 1) = Time



'Save data

If ActiveWorkbook.Saved = False Then

ActiveWorkbook.Save

End If


' Call StartTimer to schedule the procedure

StartTimer



End Sub


Sub StopTimer()

On Error Resume Next

Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=False

End Sub

 

[Jim Cone]

Qualify All workbook, worksheet and range callouts.
For example...
ThisWorkbook.Worksheets("Monitor").UsedRange
Also, the code should be in standard module not a sheet module.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"Priyanka"
<[email protected]>
wrote in message
Hi
I have a macro 'Adder' that is scheduled to run every fifteen minutes
on a particular workbook which contains a worksheet called 'Monitor'.
However, if another workbook is opened while this macro is running,
the macro tries to find the sheet Monitor in the other open workbook
and returns a 'subscript out of range error'. How do I prevent this?
Please help. The code is pasted below. Thanks a bunch in advance
Priyanka
-snip-

 

[FSt1]

hi
unless otherwise specified, vb assumes it's to run in the active workbook.
you will need to change some of your references to include refterences to
the correct fworkbook. i noticed that you use the term select in your code.
this can only be done on the active sheet. best to use varaiable in this case
to avoid using the select command. you also used the term Activesheet. avoid
this also.

Regards
FSt1

Hi

I have a macro 'Adder' that is scheduled to run every fifteen minutes
on a particular workbook which contains a worksheet called 'Monitor'.
However, if another workbook is opened while this macro is running,
the macro tries to find the sheet Monitor in the other open workbook
and returns a 'subscript out of range error'. How do I prevent this?
Please help. The code is pasted below. Thanks a bunch in advance
Priyanka


Public RunWhen As Double

Public Const cRunIntervalSeconds = 900 ' FIFTEEN minutes

Public Const cRunWhat = "CopyDataMacro" ' the name of the procedure
to run


Dim Sht1RowCount, Sht1ColCount As Long



Public Sub Adder()

Worksheets.Add.Name() = "Sheet2"

'Calculate size of input

Sheets("Monitor").Select

Sht1RowCount = ActiveSheet.UsedRange.Rows.Count

Sht1ColCount = ActiveSheet.UsedRange.Columns.Count




Range(Cells(5, 1), Cells(5, Sht1ColCount)).Select

Range(Cells(5, 1), Cells(5, Sht1ColCount)).Copy




'Initiate Sheet2



'Copy header row from Monitor to initiate

Sheets("Sheet2").Select

Range(Cells(1, 1), Cells(1, Sht1ColCount)).Select

ActiveSheet.Paste

CopyDataMacro

End Sub


Sub StartTimer()

RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)

Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True

End Sub

Sub CopyDataMacro()




'Select data rows from Monitor sheet

Sheets("Monitor").Select

Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Select

Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Copy



'Determine input in Sheet2 sheet

Sheets("Sheet2").Select

Dim LastRow, LastColumn As Long



If WorksheetFunction.CountA(Cells) > 0 Then

'Search for any entry, by searching backwards by Rows.

LastRow = Cells.Find(What:="*", After:=[A1], _

SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious).Row

End If


If WorksheetFunction.CountA(Cells) > 0 Then

'Search for any entry, by searching backwards by Columns.

LastColumn = Cells.Find(What:="*", After:=[A1], _

SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious).Column



End If




'Paste in Sheet2 Sheet

Range(Cells(LastRow + 1, 1), Cells(LastRow + Sht1RowCount - 1,
Sht1ColCount)).Select

Selection.PasteSpecial Paste:=xlValues

Cells(LastRow + 1, 1) = Time



'Save data

If ActiveWorkbook.Saved = False Then

ActiveWorkbook.Save

End If


' Call StartTimer to schedule the procedure

StartTimer



End Sub


Sub StopTimer()

On Error Resume Next

Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=False

End Sub