Multi Sheet - Recording Macro

[thunderfoot]

I want to record the data (A5:X?) below the data shown by BA in EXCEL. Reason being I want to keep tabs on my BACKing/LAYing actions so that I have a record of when the triggers have been sent and for how much for, then I can tweak the triggers/modifiers if needed. I want to have a worksheet open for each event, so UK Horse Races appear on one tab, Irish Horses on another, FTSE on another etc. etc. The obvious reason for this is because UK & Irish races can start at the same time and can conflict with each other as well as both these events conflicting with the FTSE market.

I have the following worksheet macro operating on one worksheet:-

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

10    If Range("AA1") = "Copy" Then
20    Application.Goto Reference:="A5:X20"
30    Selection.Copy
40    Sheets("Sheet 1").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
50    Application.CutCopyMode = False
60    Range("A1").Select
70    Else
80    End If
End Sub


Cell AA1 is a formula that returns either 'Copy' or 'No Copy', and controls how often data will be copied, or stop copying if the market is Suspended.

How do I get this (or similar) macro to operate on each and every worksheet so there is no conflict between the worksheets?

Realise the problem is probably row 30,40 & 60 but my skills on writing macros tend to be Record macro then do a bit of manual editting

[osknows]

The easiest option to get you by is to run seperate workbooks for each market, that way any code will run independently within it's own workbook.

If you do want to run several markets across worksheets in the same workbook you have to realise that many worksheets could be triggering close together or at the same time, your code can be interupted midflow by another event. Therfore, code would be better placed in a 'Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)' event.

Also, avoid all select, activate, goto and selection copy references.

If it helps I'll give this a go at the weekend to see if any problems arise and let you know.

[thunderfoot]

If it helps I'll give this a go at the weekend to see if any problems arise and let you know.

Oh, yes please!!

[osknows]

Right, I think I have something with a bit of help from some friends

This is a generic structure which goes into the ThisWorkbook object in the VBA editor. You can run seperate code for each worksheet using the case statement or use the Case Else to run a generic code for everything

Due to multiple events, you need to remove all references to Application.EnableEvents from ALL code you intend to use. Instead this uses public boolean variables to define if the code has finished running to avoid re-triggering.

Ensure the DoEvents statement is included in every subroutine process to capture new events.

The last event to trigger will complete first, so I'm unsure of performance issues with this for large no. of worksheets.

Code: Select all

Public process_sheet1 As Boolean
Public process_sheet2 As Boolean
Public process_sheet3 As Boolean
Public process_sheet4 As Boolean
Public process_else As Boolean

Public Sub Workbook_Open()

process_sheet1 = True
process_sheet2 = True
process_sheet3 = True
process_sheet4 = True
process_else = True
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
  Select Case Sh.Index
    Case 1
     If process_sheet1 Then
      'call a subroutine to process sheet1
      subroutine_to_process_sheet1 (Sh.Index)
     End If
    Case 2
     If process_sheet2 Then
      'call a subroutine to process sheet2
      subroutine_to_process_sheet1 (Sh.Index)
     End If
    Case 3
     If process_sheet3 Then
      'call a subroutine to process sheet3
      subroutine_to_process_sheet1 (Sh.Index)
     End If
    Case 4
     If process_sheet4 Then
      'call a subroutine to process sheet4
      subroutine_to_process_sheet1 (Sh.Index)
     End If
    Case Else
    If process_else Then
     'call a subroutine to process all other sheets
     subroutine_to_process_sheet1 (Sh.Index)
    End If
  End Select
End Sub
 
Private Sub subroutine_to_process_sheet1(val As Integer)
process_sheet1 = False
For i = 1 To 1000000
    DoEvents
Next i
 
  MsgBox (val)
process_sheet1 = True
End Sub
 
Private Sub subroutine_to_process_sheet2(val As Integer)
process_sheet2 = False 'Disable a new instance to process sheet2
For i = 1 To 1000000
    DoEvents
Next i
 
  MsgBox (val)
process_sheet1 = True  'Enable new instance to process sheet2
End Sub



If you need help adapting this to your own needs let me know

Also, there is potentially another solution...you could link all required worksheets into 1 main worksheet and monitor event changes in the main worksheet. The main worksheet updates can then link back into each seperate worksheet

[thunderfoot]

Thanks for this 'Os'.

Haven't a clue what each routine does, especially :-

Code: Select all

For i = 1 To 1000000
    DoEvents
Next i


..... is this correct >>>>

Code: Select all

    Case 2
     If process_sheet2 Then
      'call a subroutine to process sheet2
      subroutine_to_process_sheet1 (Sh.Index)
     End If


.... should 'sheet1' not read 'sheet2'?

[osknows]

If you copy my code to a blank workbook, then make a change on sheet1, sheet2 and sheet3 in quick succession you will see how the code works

To amend you need to change the subroutines to whatever you need. Also, the code is set up for 4 worksheets with anything greater caughed by the CASE ELSE

Code: Select all

Private Sub subroutine_to_process_sheet1(val As Integer)
process_sheet1 = False
For i = 1 To 1000000
    DoEvents
Next i
 
  MsgBox (val)
process_sheet1 = True
End Sub


This is just a generic example - replace this with whatever routines you need in the format below. In the above example given I have just created a delay using a FOR/NEXT loop and a message with the sheet number of the completed code for worksheet change event

Code: Select all

Private Sub subroutine_to_process_sheet1(val As Integer)
process_sheet1 = False
DoEvents

'INSERT CODE HERE

process_sheet1 = True
End Sub



Thanks for this 'Os'.

Haven't a clue what each routine does, especially :-

Code: Select all

For i = 1 To 1000000
    DoEvents
Next i


..... is this correct >>>>

Code: Select all

    Case 2
     If process_sheet2 Then
      'call a subroutine to process sheet2
      subroutine_to_process_sheet1 (Sh.Index)
     End If


.... should 'sheet1' not read 'sheet2'?

Set this to run whatever subroutine you want; could be

subroutine_to_process_sheet1 (Sh.Index)
or
subroutine_to_process_sheet2 (Sh.Index)
or
whatever_proc_you_want (Sh.Index)

[osknows]

If you get stuck, PM me the code you want to run for each worksheet and I'll set up for you

[osknows]

This should work with your original code at the top of the post

Code: Select all

Public process_sheet1 As Boolean
Public process_sheet2 As Boolean
Public process_sheet3 As Boolean
Public process_sheet4 As Boolean
Public process_else As Boolean

Public Sub Workbook_Open()

process_sheet1 = True
process_sheet2 = True
process_sheet3 = True
process_sheet4 = True
process_else = True
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
  Select Case Sh.Index
    Case 1
     If process_sheet1 Then
      'call a subroutine to process sheet1
      subroutine_to_process_sheet1 (Sh.Index)
     End If
    Case 2
     If process_sheet2 Then
      'call a subroutine to process sheet2
      subroutine_to_process_sheet2 (Sh.Index)
     End If
    Case 3
     If process_sheet3 Then
      'call a subroutine to process sheet3
      subroutine_to_process_sheet3 (Sh.Index)
     End If
    Case 4
     If process_sheet4 Then
      'call a subroutine to process sheet4
      subroutine_to_process_sheet4 (Sh.Index)
     End If
    Case Else
    If process_else Then
     'call a subroutine to process all other sheets
     subroutine_to_process_else (Sh.Index)
    End If
  End Select
End Sub
 
Private Sub subroutine_to_process_sheet1(val As Integer)
process_sheet1 = False
    DoEvents
   
If ThisWorkbook.Sheets(val).Range("A1") = "Copy" Then
Set x = ThisWorkbook.Sheets(val).Range("A5:X20")
varArray = x.Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray

Else
End If
process_sheet1 = True
End Sub
 
Private Sub subroutine_to_process_sheet2(val As Integer)
process_sheet2 = False
    DoEvents
   
If ThisWorkbook.Sheets(val).Range("A1") = "Copy" Then
Set x = ThisWorkbook.Sheets(val).Range("A5:X20")
varArray = x.Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray

Else
End If
process_sheet2 = True
End Sub
Private Sub subroutine_to_process_sheet3(val As Integer)
process_sheet3 = False
    DoEvents
   
If ThisWorkbook.Sheets(val).Range("A1") = "Copy" Then
Set x = ThisWorkbook.Sheets(val).Range("A5:X20")
varArray = x.Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray

Else
End If
process_sheet3 = True
End Sub
Private Sub subroutine_to_process_sheet4(val As Integer)
process_sheet4 = False
    DoEvents
   
If ThisWorkbook.Sheets(val).Range("A1") = "Copy" Then
Set x = ThisWorkbook.Sheets(val).Range("A5:X20")
varArray = x.Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray

Else
End If
process_sheet4 = True
End Sub

Private Sub subroutine_to_process_else(val As Integer)
process_else = False
    DoEvents
   
If ThisWorkbook.Sheets(val).Range("A1") = "Copy" Then
Set x = ThisWorkbook.Sheets(val).Range("A5:X20")
varArray = x.Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray

Else
End If
process_else = True
End Sub


Copy this into Thisworkbook object. Save, close then re-open

[mak]

Hi
as Osknows knows I am no good in vba but I think you'll have to replace
range a1 with aa1 in order to work...

[osknows]

Just noticed an error, for each variable x and varArray you will need to rename these for every seperate procedure

Eg x1, x2,....xY
varArray1, varArray2,....varArrayY

eg

Code: Select all

Private Sub subroutine_to_process_sheet1(val As Integer)
process_sheet1 = False
    DoEvents
   
If ThisWorkbook.Sheets(val).Range("A1") = "Copy" Then
Set x1 = ThisWorkbook.Sheets(val).Range("A5:X20")
varArray1 = x1.Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(varArray1, 1), UBound(varArray1, 2)).Value = varArray1

Else
End If
process_sheet1 = True
End Sub


[thunderfoot]

Thanks 'Os',

Will try later on ....... typically, Internet's been down since 1300 Hrs!!

[thunderfoot]

How is the 'else' process corrected??

Code: Select all

Private Sub subroutine_to_process_else(val As Integer)
process_else = False
    DoEvents
   
If ThisWorkbook.Sheets(val).Range("A1") = "Copy" Then
Set x = ThisWorkbook.Sheets(val).Range("A5:X20")
varArray = x.Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray

Else
End If
process_else = True
End Sub

[osknows]

Ok, scrap all earlier code and try this...

Insert a new module and enter this

Code: Select all

'increase (100) if more than 100 worksheets in use
Public barange(100), bavarArray(100) As Variant
Public process_sheet(100) As Boolean


If you want seperate code for each worksheet use the following placed in ThisWorkbook object. This example has routines for the first 4 worksheets and the rest are captured by the CASE ELSE. You can extend this to any number of cases with seprate routine for each

Code: Select all

Public Sub Workbook_Open()
For bacount = 0 To 100 'change 100 to match number of worksheets
process_sheet(bacount) = True
Next bacount
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
  Select Case Sh.Index
    Case 1
     If process_sheet(Sh.Index) Then
      'call a subroutine to process sheet1
      subroutine_to_process_sheet1 (Sh.Index)
     End If
    Case 2
     If process_sheet(Sh.Index) Then
      'call a subroutine to process sheet2
      subroutine_to_process_sheet2 (Sh.Index)
     End If
    Case 3
     If process_sheet(Sh.Index) Then
      'call a subroutine to process sheet3
      subroutine_to_process_sheet3 (Sh.Index)
     End If
    Case 4
     If process_sheet(Sh.Index) Then
      'call a subroutine to process sheet4
      subroutine_to_process_sheet4 (Sh.Index)
     End If
    Case Else
    If process_sheet(Sh.Index) Then
     'call a subroutine to process all other sheets
     subroutine_to_process_else (Sh.Index)
    End If
  End Select
End Sub
 
Private Sub subroutine_to_process_sheet1(val As Integer)
process_sheet(val) = False
    DoEvents

If ThisWorkbook.Sheets(val).Range("AA1") = "Copy" Then
Set barange(val) = ThisWorkbook.Sheets(val).Range("A5:X20")
bavarArray(val) = barange(val).Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(bavarArray(val), 1), UBound(bavarArray(val), 2)).Value = bavarArray(val)

Else
End If
process_sheet(val) = True
End Sub

Private Sub subroutine_to_process_sheet2(val As Integer)
process_sheet(val) = False
    DoEvents

If ThisWorkbook.Sheets(val).Range("AA1") = "Copy" Then
Set barange(val) = ThisWorkbook.Sheets(val).Range("A5:X20")
bavarArray(val) = barange(val).Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(bavarArray(val), 1), UBound(bavarArray(val), 2)).Value = bavarArray(val)

Else
End If
process_sheet(val) = True
End Sub
Private Sub subroutine_to_process_sheet3(val As Integer)
process_sheet(val) = False
    DoEvents

If ThisWorkbook.Sheets(val).Range("AA1") = "Copy" Then
Set barange(val) = ThisWorkbook.Sheets(val).Range("A5:X20")
bavarArray(val) = barange(val).Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(bavarArray(val), 1), UBound(bavarArray(val), 2)).Value = bavarArray(val)

Else
End If
process_sheet(val) = True
End Sub
Private Sub subroutine_to_process_sheet4(val As Integer)
process_sheet(val) = False
    DoEvents

If ThisWorkbook.Sheets(val).Range("AA1") = "Copy" Then
Set barange(val) = ThisWorkbook.Sheets(val).Range("A5:X20")
bavarArray(val) = barange(val).Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(bavarArray(val), 1), UBound(bavarArray(val), 2)).Value = bavarArray(val)

Else
End If
process_sheet(val) = True
End Sub
Private Sub subroutine_to_process_else(val As Integer)
process_sheet(val) = False
    DoEvents

If ThisWorkbook.Sheets(val).Range("AA1") = "Copy" Then
Set barange(val) = ThisWorkbook.Sheets(val).Range("A5:X20")
bavarArray(val) = barange(val).Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(bavarArray(val), 1), UBound(bavarArray(val), 2)).Value = bavarArray(val)

Else
End If
process_sheet(val) = True
End Sub


If you want to run the same code for each worksheet use this simpler version in ThisWorkbook

Code: Select all

Public Sub Workbook_Open()
For bacount = 0 To 100 'increase 100 if more than 100 worksheets in use
process_sheet(bacount) = True
Next bacount
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 

    If process_sheet(Sh.Index) Then
     'call a subroutine to process all other sheets
     subroutine_to_process_else (Sh.Index)
    End If

End Sub
 

Private Sub subroutine_to_process_else(val As Integer)
process_sheet(val) = False

DoEvents
If ThisWorkbook.Sheets(val).Range("AA1") = "Copy" Then
Set barange(val) = ThisWorkbook.Sheets(val).Range("A5:X20")
bavarArray(val) = barange(val).Value
ThisWorkbook.Sheets(val).Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(bavarArray(val), 1), UBound(bavarArray(val), 2)).Value = bavarArray(val)

Else
End If
process_sheet(val) = True
End Sub