VBA to insert formula in multiple sheets

asad

Well-known Member
Joined
Sep 9, 2008
Messages
1,434
hello Guys,

I have following code where I am trying to insert array formulas n same ranges in different sheets.
Code:
Sub RunSheets()Dim FormulaOneA As String, FormulaOneB As String, FormulaTwoA As String, FormulaTwoB As String, FormulaTwoC As String, FormulaThreeA As String, FormulaThreeB As String, FormulaThreeC As String
Dim FormulaFourA As String, FormulaFourB As String
Dim ws As Worksheet
Dim ar As Areas


    For Each ws In Worksheets(Array("Sun Run Sheet", "Mon Run Sheet", "Tue Run Sheet", "Wed Run Sheet", "Thu Run Sheet", "Fri Run Sheet", "Sat Run Sheet"))
        With ws.Range("A5:O170")
    
            ws.Range("A5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$S$1:$S$3000,MATCH(1,('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$B$1:$B$3000=B5),0)),"""")"
            ws.Range("B5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$B$1:$B$3000,SMALL(IF(('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5),ROW('Timetarget Roster Export'!$E$2:$E$3000)),COUNTIF(F$5:F5,F5))),"""")"
            ws.Range("C5").FormulaArray = "=IF(D5=""Vacant"","""",IF(D5="""","""",IFERROR(VLOOKUP(D5*1,Emp!$B$2:$E$350,4,FALSE),"""")))"


[COLOR=#ff0000]                ws.Range("A5").Copy ws.Range("A6:A170")[/COLOR]
                ws.Range("B5").Copy ws.Range("B6:B170")
                ws.Range("C5").Copy ws.Range("C6:C170")
                


        End With
    Next ws


End Sub

The code worked when I entered the formula in one cell in each sheet. But it gave ma an error and the line in red above gets highlighted in yellow when I added the next bit trying to copy one cell in the range below for all sheets.
What is it that I am doing wrong?
Regards

Asad
 
Last edited:
Hello Guys,
It's me again with another small issue for you but a massive one for me - AGAIN! I know.
Here is the final code that works perfect:
Code:
Sub RunSheet2()Dim ws As Worksheet
Dim FM1A As String, FM1B As String, FM2A As String, FM2B As String, FM2C As String


    FM1A = "=IFERROR(INDEX('Timetarget Roster Export'!$AP$1:$AP$3000,SMALL(IF(('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*X_X1,ROW('Timetarget Roster Export'!$E$2:$E$3000)),COUNTIF(F$5:F5,F5))),"""")"
    FM1B = "(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5)*('Timetarget Roster Export'!$S$2:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$2:$S$3000<>""OTL's"")"
    FM2A = "=IFERROR(INDEX('Timetarget Roster Export'!$AF$1:$AF$3000,SMALL(IF(X_X2B,X_X2C),COUNTIF(F$5:F5,F5)))&"", ""&INDEX('Timetarget Roster Export'!$AE$1:$AE$3000,SMALL(IF(X_X2B,X_X2C),COUNTIF(F$5:F5,F5))),"""")"
    FM2B = "('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5)*('Timetarget Roster Export'!$S$2:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$2:$S$3000<>""OTL's"")"
    FM2C = "ROW('Timetarget Roster Export'!$E$2:$E$3000))"
            
    
    For Each ws In Worksheets(Array("Sun Run Sheet", "Mon Run Sheet", "Tue Run Sheet", "Wed Run Sheet", "Thu Run Sheet", "Fri Run Sheet", "Sat Run Sheet"))
        With ws
           
                .Range("A5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$S$1:$S$3000,MATCH(1,('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$B$1:$B$3000=B5),0)),"""")"
                .Range("B5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$B$1:$B$3000,SMALL(IF(('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5),ROW('Timetarget Roster Export'!$E$2:$E$3000)),COUNTIF(F$5:F5,F5))),"""")"
                .Range("C5").FormulaArray = "=IF(D5=""Vacant"","""",IF(D5="""","""",IFERROR(VLOOKUP(D5*1,Emp!$B$2:$E$350,4,FALSE),"""")))"
                .Range("D5").FormulaArray = FM1A
                .Range("D5").Replace "X_X1", FM1B
                .Range("E5").FormulaArray = FM2A
                .Range("E5").Replace "X_X2B", FM2B
                .Range("E5").Replace "X_X2C)", FM2C
                .Range("F5").FormulaArray = "=IFERROR(SMALL(IF(('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$S$1:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$1:$S$3000<>""OTL's""),('Timetarget Roster Export'!$E$1:$E$3000)*1),ROWS(G$5:G5)),"""")"
                .Range("G5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:H5),FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:H5),FALSE)),"""")"
                .Range("H5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:I5),FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:I5),FALSE)),"""")"
                .Range("J5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:K5)-1,FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:K5)-1,FALSE)),"""")"
                .Range("K5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:L5)-1,FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:L5)-1,FALSE)),"""")"
                .Range("O5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$O$1:$O$3000,MATCH(1,('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$B$1:$B$3000=TEXT($B5,""0000"")),0)),"""")"
                
                
                    .Range("A5:O170").FillDown
                    .Range("A5:O170").Value = .Range("A5:O170").Value
                    


        End With
    Next ws


End Sub

And here is the code that I recorded for adding sorting into the code above:
Code:
    Range("A5:O170").Select
    ActiveWorkbook.Worksheets("Sun Run Sheet").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sun Run Sheet").Sort.SortFields.Add Key:=Range( _
        "A5:A170"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Express,St Kilda,Avalon,Frankston", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sun Run Sheet").Sort
        .SetRange Range("A5:O170")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

But I cannot figure out how can I avoid using the sheet name and instead of sorting only one sheet, the code should sort all sheets.
And after sorting I will try to conditionally format using the code itself. The colour will be based on column "A" Values and one colour for each category that is mentioned in the sorting part. Is it possible to incorporate all of this in one?

Asad
 
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Hello All Gurus,
I finally managed to put together the following code after copy pasting from various posts. But this looks a bit shabby. Although it is working, but I would prefer if someone can have a look at it and let me know if this can be cleaned a =bit and made a bit smaller or not.

Code:
Sub RunSheet2()Dim ws As Worksheet
Dim FM1A As String, FM1B As String, FM2A As String, FM2B As String, FM2C As String


    FM1A = "=IFERROR(INDEX('Timetarget Roster Export'!$AP$1:$AP$3000,SMALL(IF(('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*X_X1,ROW('Timetarget Roster Export'!$E$2:$E$3000)),COUNTIF(F$5:F5,F5))),"""")"
    FM1B = "(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5)*('Timetarget Roster Export'!$S$2:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$2:$S$3000<>""OTL's"")"
    FM2A = "=IFERROR(INDEX('Timetarget Roster Export'!$AF$1:$AF$3000,SMALL(IF(X_X2B,X_X2C),COUNTIF(F$5:F5,F5)))&"", ""&INDEX('Timetarget Roster Export'!$AE$1:$AE$3000,SMALL(IF(X_X2B,X_X2C),COUNTIF(F$5:F5,F5))),"""")"
    FM2B = "('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5)*('Timetarget Roster Export'!$S$2:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$2:$S$3000<>""OTL's"")"
    FM2C = "ROW('Timetarget Roster Export'!$E$2:$E$3000))"
            
    
    For Each ws In Worksheets(Array("Sun Run Sheet", "Mon Run Sheet", "Tue Run Sheet", "Wed Run Sheet", "Thu Run Sheet", "Fri Run Sheet", "Sat Run Sheet"))
        With ws
           
                .Range("A5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$S$1:$S$3000,MATCH(1,('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$B$1:$B$3000=B5),0)),"""")"
                .Range("B5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$B$1:$B$3000,SMALL(IF(('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5),ROW('Timetarget Roster Export'!$E$2:$E$3000)),COUNTIF(F$5:F5,F5))),"""")"
                .Range("C5").FormulaArray = "=IF(D5=""Vacant"","""",IF(D5="""","""",IFERROR(VLOOKUP(D5*1,Emp!$B$2:$E$350,4,FALSE),"""")))"
                .Range("D5").FormulaArray = FM1A
                .Range("D5").Replace "X_X1", FM1B
                .Range("E5").FormulaArray = FM2A
                .Range("E5").Replace "X_X2B", FM2B
                .Range("E5").Replace "X_X2C)", FM2C
                .Range("F5").FormulaArray = "=IFERROR(SMALL(IF(('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$S$1:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$1:$S$3000<>""OTL's""),('Timetarget Roster Export'!$E$1:$E$3000)*1),ROWS(G$5:G5)),"""")"
                .Range("G5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:H5),FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:H5),FALSE)),"""")"
                .Range("H5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:I5),FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:I5),FALSE)),"""")"
                .Range("J5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:K5)-1,FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:K5)-1,FALSE)),"""")"
                .Range("K5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:L5)-1,FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:L5)-1,FALSE)),"""")"
                .Range("O5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$O$1:$O$3000,MATCH(1,('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$B$1:$B$3000=TEXT($B5,""0000"")),0)),"""")"
                
                
                    .Range("A5:O170").FillDown
                    .Range("A5:O170").Value = .Range("A5:O170").Value
                    .Range("A5:O170").Interior.Color = xlNone
                    .Range("A5:O170").Font.Color = vbBlack
                        Range("A5:O170").Select
                        ws.Sort.SortFields.Clear
                        ws.Sort.SortFields.Add Key:=Range("A5:A170"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="Express,LTCP,St Kilda,Avalon,Frankston", DataOption:=xlSortNormal
                            With ws.Sort
                                .SetRange Range("A5:O170")
                                .Header = xlGuess
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                            
                     For Each c In .Range("A5:A170")
                        If c.Value = "Express" Then c.Interior.Color = 192
                            If c.Value = "LTCP" Then c.Interior.Color = 49407
                                If c.Value = "Frankston" Then c.Interior.Color = 32768
                                    If c.Value = "St Kilda" Then c.Interior.Color = RGB(128, 96, 0)
                                        If c.Value = "Avalon" Then c.Interior.Color = 10498160
                                            If c.Value = "" Then c.Interior.Color = xlNone
                     Next c
        End With
    Next ws


End Sub

Thanks for your time. Your help is much appreciated.
Asad
 
Upvote 0
Hi Guys,
Hope someone can help me to unselect the ranges in all the sheets after the code has finished running. the code so far is like this:
Code:
Sub RunSheet2()Dim ws As Worksheet
Dim FM1A As String, FM1B As String, FM2A As String, FM2B As String, FM2C As String, FM3A As String, FM3B As String, FM4A As String, FM4B As String


    FM1A = "=IFERROR(INDEX('Timetarget Roster Export'!$AP$1:$AP$3000,SMALL(IF(('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*X_X1,ROW('Timetarget Roster Export'!$E$2:$E$3000)),COUNTIF(F$5:F5,F5))),"""")"
    FM1B = "(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5)*('Timetarget Roster Export'!$R$2:$R$3000<>""Skybus Gold Coast"")*('Timetarget Roster Export'!$S$2:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$2:$S$3000<>""OTL's"")"
    FM2A = "=IFERROR(INDEX('Timetarget Roster Export'!$AF$1:$AF$3000,SMALL(IF(X_X2B,X_X2C),COUNTIF(F$5:F5,F5)))&"", ""&INDEX('Timetarget Roster Export'!$AE$1:$AE$3000,SMALL(IF(X_X2B,X_X2C),COUNTIF(F$5:F5,F5))),"""")"
    FM2B = "('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5)*('Timetarget Roster Export'!$R$2:$R$3000<>""Skybus Gold Coast"")*X_X2D"
    FM2D = "('Timetarget Roster Export'!$S$2:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$2:$S$3000<>""OTL's"")"
    FM2C = "ROW('Timetarget Roster Export'!$E$2:$E$3000))"
    FM3A = "=IFERROR(SMALL(IF(X_X3A,('Timetarget Roster Export'!$E$1:$E$3000)*1),ROWS(G$5:G5)),"""")"
    FM3B = "('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$R$1:$R$3000<>""Skybus Gold Coast"")*('Timetarget Roster Export'!$S$1:$S$3000<>""Cleaners"")*('Timetarget Roster Export'!$S$1:$S$3000<>""OTL's"")"
    FM4A = "=IFERROR(INDEX('Timetarget Roster Export'!$B$1:$B$3000,SMALL(IF(X_X4B,ROW('Timetarget Roster Export'!$E$2:$E$3000)),1)),"""")"
    FM4B = "('Timetarget Roster Export'!$D$2:$D$3000=$B$3)*('Timetarget Roster Export'!$C$2:$C$3000=TEXT(D5,""00000""))*(('Timetarget Roster Export'!$E$2:$E$3000)*1=F5)"
    
    For Each ws In Worksheets(Array("Sun Run Sheet", "Mon Run Sheet", "Tue Run Sheet", "Wed Run Sheet", "Thu Run Sheet", "Fri Run Sheet", "Sat Run Sheet"))
        With ws
           
                .Range("A5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$S$1:$S$3000,MATCH(1,('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$B$1:$B$3000=B5),0)),"""")"
                .Range("B5").FormulaArray = FM4A
                .Range("B5").Replace "X_X4B", FM4B
                .Range("C5").FormulaArray = "=IF(D5=""Vacant"","""",IF(D5="""","""",IFERROR(VLOOKUP(D5*1,Emp!$B$2:$E$350,4,FALSE),"""")))"
                .Range("D5").FormulaArray = FM1A
                .Range("D5").Replace "X_X1", FM1B
                .Range("E5").FormulaArray = FM2A
                .Range("E5").Replace "X_X2B", FM2B
                .Range("E5").Replace "X_X2D", FM2D
                .Range("E5").Replace "X_X2C)", FM2C
                .Range("F5").FormulaArray = FM3A
                .Range("F5").Replace "X_X3A", FM3B
                .Range("G5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:H5),FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:H5),FALSE)),"""")"
                .Range("H5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:I5),FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:I5),FALSE)),"""")"
                .Range("J5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:K5)-1,FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:K5)-1,FALSE)),"""")"
                .Range("K5").Formula = "=IFERROR(IFERROR(VLOOKUP($B5," & TOD & ",COLUMNS($F5:L5)-1,FALSE),VLOOKUP($B5*1," & TOD & ",COLUMNS($F5:L5)-1,FALSE)),"""")"
                .Range("O5").FormulaArray = "=IFERROR(INDEX('Timetarget Roster Export'!$O$1:$O$3000,MATCH(1,('Timetarget Roster Export'!$D$1:$D$3000=$B$3)*('Timetarget Roster Export'!$B$1:$B$3000=TEXT($B5,""0000"")),0)),"""")"
                
                
                    .Range("A5:O170").FillDown
                    .Range("A5:O170").Value = .Range("A5:O170").Value
                    .Range("A5:O170").Interior.Color = xlNone
                    .Range("A5:O170").Font.Color = vbBlack
                        Range("A5:O170").Select
                        ws.Sort.SortFields.Clear
                        ws.Sort.SortFields.Add Key:=Range("A5:A170"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="Express,LTCP,St Kilda Express,City Transfer,Avalon,Frankston", DataOption:=xlSortNormal
                            With ws.Sort
                                .SetRange Range("A5:O170")
                                .Header = xlGuess
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                                                        
                     For Each c In .Range("A5:A170")
                        If c.Value = "Express" Then
                         c.Offset(, 1).Interior.Color = 192
                         c.Offset(, 1).Font.Color = vbWhite
                            Else
                            If c.Value = "LTCP" Then
                            c.Offset(, 1).Interior.Color = 49407
                            c.Offset(, 1).Font.Color = vbBlack
                                Else
                                If c.Value = "Frankston" Then
                                c.Offset(, 1).Interior.Color = 32768
                                c.Offset(, 1).Font.Color = vbWhite
                                    Else
                                    If c.Value = "St Kilda Express" Then
                                    c.Offset(, 1).Interior.Color = RGB(128, 96, 0)
                                    c.Offset(, 1).Font.Color = vbWhite
                                        Else
                                        If c.Value = "Avalon" Then
                                        c.Offset(, 1).Interior.Color = 10498160
                                        c.Offset(, 1).Font.Color = vbWhite
                                            Else
                                            If c.Value = "City Transfer" Then
                                            c.Offset(, 1).Interior.Color = 12611584
                                            c.Offset(, 1).Font.Color = vbWhite
                                               Else
                                               If c.Value = "" Then
                                               c.Offset(, 1).Interior.Color = xlNone
                                               c.Offset(, 1).Font.Color = vbBlack
                                               End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    Next c
        End With
    Next ws
End Sub

After it has finished, all the seven sheets have range("A5:O170") still selected. I know it doesn't do any harm, but I would prefer those ranges not to be showing in grey. Is it possible?

Thanks
Asad
 
Upvote 0

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,632
Latest member
jladair

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top