Running VBA Code simultaneously on other identical worksheets from one main worksheet

[Jan Kalop]

How to make to run below VBA Code simultaneously on 5 other identical worksheets but with different data and name of the worksheets, from main Worksheets("MonDBS")

The other worksheet are:

Worksheets("TueDBS")
Worksheets("WedDBS")
Worksheets("ThuDBS")
Worksheets("FriDBS")
Worksheets("SatDBS")

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim A As Long
Dim B55 As Range: Set B55 = Range("B55")
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, B55) Is Nothing Then
For A = 57 To 700
If Cells(A, 2).Value = B55.Value Then Cells(A, 2).Resize(, 158).Value = Worksheets("MonDBS").Range("B55:FC55").Value
Next A
Set B55 = Nothing
End If
End Sub

 

[rlv01]

If you want to have a common Private Sub Worksheet_SelectionChange(ByVal Target As Range) event subrountine that you can use in six different worksheets, but which reference different 'DBS' worksheets then there must be a means of choosing that can be expressed in code.

1. How do you chose which of

​

Worksheets("MonDBS")​

Worksheets("TueDBS")​

Worksheets("WedDBS")​

Worksheets("ThuDBS")​

Worksheets("FriDBS")​

Worksheets("SatDBS")​

each one of your 6 worksheets will use?

2. What specifically do you mean by "different data"?

(Tip: when posting code, please try to use 'code tags' to format your code.

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

It makes the code easier to read.)

 

[Jan Kalop]

If you want to have a common Private Sub Worksheet_SelectionChange(ByVal Target As Range) event subrountine that you can use in six different worksheets, but which reference different 'DBS' worksheets then there must be a means of choosing that can be expressed in code.

1. How do you chose which of

​

Worksheets("MonDBS")​

Worksheets("TueDBS")​

Worksheets("WedDBS")​

Worksheets("ThuDBS")​

Worksheets("FriDBS")​

Worksheets("SatDBS")​

each one of your 6 worksheets will use?

2. What specifically do you mean by "different data"?

(Tip: when posting code, please try to use 'code tags' to format your code.

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

It makes the code easier to read.)

It may help you understand what I would like to achieve. I tried COD as below but unfortunately it doesn't work. Only executes the first command for a MonDBS worksheet, ignoring the others, and I would like to be able to execute with one click using the dedicated button (B55) on the MonDBS worksheet to execute all commands for all worksheets simultaneously.

2. What specifically do you mean by "different data"?.......they are just different orders for each day of the week



"Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim A As Long
Dim B55 As Range: Set B55 = Range("B55")
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, B55) Is Nothing Then
Application.ScreenUpdating = False

For A = 57 To 700
If Worksheets("MonDBS").Cells(A, 2).Value = B55.Value Then Worksheets("MonDBS").Cells(A, 2).Resize(, 158).Value = Worksheets("MonDBS").Range("B55:FC55").Value
Next A

For B = 57 To 700
If Worksheets("TueDBS").Cells(B, 2).Value = B55.Value Then Worksheets("TueDBS").Cells(B, 2).Resize(, 158).Value = Worksheets("TueDBS").Range("B55:FC55").Value
Next B

For C = 57 To 700
If Worksheets("WedDBS").Cells(C, 2).Value = B55.Value Then Worksheets("WedDBS").Cells(C, 2).Resize(, 158).Value = Worksheets("WedDBS").Range("B55:FC55").Value
Next C

For D = 57 To 700
If Worksheets("ThuDBS").Cells(D, 2).Value = B55.Value Then Worksheets("ThuDBS").Cells(D, 2).Resize(, 158).Value = Worksheets("ThuDBS").Range("B55:FC55").Value
Next D

For E = 57 To 700
If Worksheets("FriDBS").Cells(E, 2).Value = B55.Value Then Worksheets("FriDBS").Cells(E, 2).Resize(, 158).Value = Worksheets("FriDBS").Range("B55:FC55").Value
Next E


For F = 57 To 700
If Worksheets("SatDBS").Cells(E, 2).Value = B55.Value Then Worksheets("SatDBS").Cells(E, 2).Resize(, 158).Value = Worksheets("SatDBS").Range("B55:FC55").Value
Next F

Application.ScreenUpdating = True
Set B55 = Nothing
End If
End Sub"

 

[rlv01]

I cannot help but notice that you continue not to use code tags when posting your code.

 

[Jan Kalop]

I cannot help but notice that you continue not to use code tags when posting your code.

Thankyou and sorry I forgot

 

[rlv01]

Perhaps something like this.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim A As Long
    Dim B55 As Range
    Dim SelectedWorksheet As Worksheet
    Dim DBSList As Variant, DBS As Variant

    DBSList = Array("MonDBS", "TueDBS", "WedDBS", "ThuDBS", "FriDBS", "SatDBS")

    Set B55 = Me.Range("B55")

    If Not Intersect(Target, B55) Is Nothing And Target.Cells.Count = 1 Then
        For A = 57 To 700
            For Each DBS In DBSList
                With Worksheets(DBS)
                    If .Cells(A, 2).Value = B55.Value Then
                        .Cells(A, 2).Resize(, 158).Value = .Range("B55:FC55").Value
                    End If
                End With
            Next DBS
        Next A
        Set B55 = Nothing
    End If
End Sub

 

[Jan Kalop]

Perhaps something like this.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim A As Long
    Dim B55 As Range
    Dim SelectedWorksheet As Worksheet
    Dim DBSList As Variant, DBS As Variant

    DBSList = Array("MonDBS", "TueDBS", "WedDBS", "ThuDBS", "FriDBS", "SatDBS")

    Set B55 = Me.Range("B55")

    If Not Intersect(Target, B55) Is Nothing And Target.Cells.Count = 1 Then
        For A = 57 To 700
            For Each DBS In DBSList
                With Worksheets(DBS)
                    If .Cells(A, 2).Value = B55.Value Then
                        .Cells(A, 2).Resize(, 158).Value = .Range("B55:FC55").Value
                    End If
                End With
            Next DBS
        Next A
        Set B55 = Nothing
    End If
End Sub

Thanks a lot, everything works like a Swiss watch and I am very happy and grateful to you for your help