View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Priyanka[_2_] Priyanka[_2_] is offline
external usenet poster
 
Posts: 5
Default Macro runs in another workbook if you open simultaneously

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, Procedu=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, Procedu=cRunWhat,
Schedule:=False

End Sub