0

I have a file with 20 sheets and the data on each sheet is structured in the same position (all 20 sheets are mirror copy of each other), only the content is different. At the moment i am updating each sheet one-by-one. I have listed 3 of the ranges below and am using Union for the formatting, but struggling with For Each Cell Loop code - how do i get it to: go to a cell P6 on each worksheet and calculate 10*5; go to cell T33 and calculate 100/10; go to cell q49 and perfor 50-5 etc. Or go to range P6:T9 and calculate 20*10. Thank you

Sub MultipleRange()
    Dim r1, r2, r3, r4, r5, r6, myMultipleRange As Range
    Set r1 = Sheets("Sheet1").Range("P6:T9")
    Set r2 = Sheets("Sheet1").Range("P28:T34")
    Set r3 = Sheets("Sheet1").Range("P55:T55")
    Set r4 = Sheets("Sheet2").Range("P6:T9")
    Set r5 = Sheets("Sheet2").Range("P28:T34")
    Set r6 = Sheets("Sheet2").Range("P55:T55")
    Set myMultipleRange = Union(r1, r2, r3, r4, r5, r6)
    myMultipleRange.Font.Color = vbBlue
End Sub
Community
  • 1
  • 1
Zakky
  • 59
  • 8

2 Answers2

1

Code such as the following can do the trick:

Sub MultipleRange()
    Dim r1 As Range, r2 As Range, r3 As Range
    Dim r4 As Range, r5 As Range, r6 As Range
    Dim myMultipleRange As Range
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws

            Set r1 = .Range("P6:T9")
            Set r2 = .Range("P28:T34")
            Set r3 = .Range("P55:T55")
            Set r4 = .Range("P6:T9")
            Set r5 = .Range("P28:T34")
            Set r6 = .Range("P55:T55")
            Set myMultipleRange = Union(r1, r2, r3, r4, r5, r6)
            myMultipleRange.Font.Color = vbBlue

        End With
    Next ws
End Sub
basodre
  • 5,720
  • 1
  • 15
  • 23
1

I used the code of @user3561813 and slightly changed it to match what I believe are your exact needs.

Sub MultipleRange()

    Dim r1 As Range, r2 As Range, r3 As Range

    Dim myMultipleRange As Range
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
'got help from http://stackoverflow.com/questions/20422356/loop-through-excel-sheets
        If (ws.Name <> "Sum") And (ws.Name <> "graphs") And (ws.Name <> "comms") Then

            With ws

                Set r1 = .Range("P6:T9")
                Set r2 = .Range("P28:T34")
                Set r3 = .Range("P55:T55")

                Set myMultipleRange = Union(r1, r2, r3)
                myMultipleRange.Font.Color = vbBlue
                r1 = 10 * 5
                r2 = 100 / 10
                r3 = 50 - 5
            End With
        End If
        Next ws

    End Sub

PS:Not sure if I should just Edit his answer and wait or just answer myself for quicker visible answer.

carlos_cs
  • 114
  • 1
  • 2
  • 10
  • how can you even do this?? "go to a cell P6 on each worksheet and calculate 10*5 or go to range P6:T9 and calculate 20*10. " Can you elaborate better? – carlos_cs May 05 '16 at 13:48
  • Thank for the prompt reply. When i execute it comes up with Run-time error 1004 and highlights the – Zakky May 07 '16 at 00:05
  • Thanks for the reply. When i execute the code it comes up with run-time error 1004 and highlights the line - myMultipleRange.Font.Color = vbBlue - in yellow. all other code is fine. – Zakky May 07 '16 at 00:07
  • I forgot to say that the file as 20 working sheets but the other sheets are non-working sheets i.e. summary, graphs and commentary etc. I don't want these to be impacted by the code. The names of the sheets are: Sum, graphs and comms. I don't want these sheets to be changes by the code. Ta – Zakky May 07 '16 at 00:15
  • I try to run the code in an empty sheet and it doesn't give me any errors. – carlos_cs May 07 '16 at 00:27
  • I've managed to get the vbBlue code working. It was me, not you. I could do with your help on changing the code for my other query i.e. excluding certain sheets. – Zakky May 07 '16 at 00:33
  • Wow! Does exactly what it says on the tin. Brilliant! Thanks!! – Zakky May 07 '16 at 00:49
  • Glad I could help even though I recently started with VBA! – carlos_cs May 07 '16 at 00:51