Is there a way to simplify this code? The code repeats on 3 sheets.

Question

I need the code to loop for specified sheets. The current code works but i had to copy and paste the code and set each sheet I wanted the code to run on as the active sheet

I had the code attached to a command button on 3 different sheets and code was set to active sheet and had to go to each sheet and click the button. I wanted a single button to control all 3 buttons or to run the code on the 3 sheets. below was my solution. Can it be looped for the named sheets (contractor labor, Material and Company Labor)?

Private Sub Update_Click()
Application.ScreenUpdating = False
Sheets("Contractor Labor Summary").Activate
ActiveSheet.Columns(1).ClearContents
ActiveSheet.Range("A2").Value = "Project"
ActiveSheet.Range("A3").Select
Dim sh As Worksheet
Dim cell As Range
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
    End If
Next sh

Sheets("Material Summary").Activate
ActiveSheet.Columns(1).ClearContents
ActiveSheet.Range("A2").Value = "Project"
ActiveSheet.Range("A3").Select
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
    End If
Next sh

Sheets("Company Labor").Activate
ActiveSheet.Columns(1).ClearContents
ActiveSheet.Range("A2").Value = "Project"
ActiveSheet.Range("A3").Select
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
    End If
Next sh
Application.ScreenUpdating = True
End Sub

If there is anything else that can be changed to make the code more clean feed back is welcomed.

[Avoiding activate and select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) is a good start — cybernetic.nomad, Dec 27 '18 at 20:06

VBasic2008 · Answer 1 · 2018-12-27T22:10:48.663

Labor (Where Did I Go Wrong)

What someone does when things are unclear (referring to Wrong 1 and Wrong 2 below).

The Final Solution

Private Sub Update_Click()

    Const cStrSheets As String = "Contractor Labor Summary," _
        & "Material Summary,Company Labor,Forecast"   ' Worksheet List

    Dim sh As Worksheet       ' Worksheet For-Each Control Variable
    Dim vntSheets As Variant  ' Worksheet Array
    Dim i As Integer          ' Worksheet Counter
    Dim j As Integer          ' Cells Counter

    Application.ScreenUpdating = False

    ' Split Worksheet List into Worksheet Array
    vntSheets = Split(cStrSheets, ",")

    ' Loop through Worksheet Array, the last is needed in the next If statement.
    For i = 0 To UBound(vntSheets) - 1

        With Worksheets(vntSheets(i))

            .Columns(1).ClearContents
            .Range("A2").Value = "Project"

            ' Insert hyperlinks linking to other worksheets (sh), not contained in
            ' Worksheet Array (vntSheets), one below the other (j).
            j = 0
            For Each sh In Worksheets
                If sh.Name <> vntSheets(0) And sh.Name <> vntSheets(1) And _
                        sh.Name <> vntSheets(2) And sh.Name <> vntSheets(3) Then
                    .Hyperlinks.Add Anchor:=.Range("A" & CStr(3 + j)), _
                            Address:="", SubAddress:="'" & sh.Name & "'" _
                            & "!A1", TextToDisplay:=sh.Name
                    j = j + 1
                End If
            Next

        End With

    Next

    Application.ScreenUpdating = True

End Sub

Wrong 1

Private Sub Update_Click()

    Const cStrSheets As String = "Contractor Labor Summary, " _
        & "Material Summary, Company Labor"

    Dim vntSheets As Variant
    Dim i As Integer

    Application.ScreenUpdating = False

    vntSheets = Split(cStrSheets, ",")

    For i = 0 To UBound(vntSheets)
        With Worksheets(Trim(vntSheets(i)))
            .Columns(1).ClearContents
            .Range("A2").Value = "Project"
            .Hyperlinks.Add Anchor:=.Range("A3"), Address:="", _
                    SubAddress:="'" & .Name & "'" & "!A1", _
                    TextToDisplay:=.Name
            .Range("A4").Select
        End With
    Next

    Application.ScreenUpdating = True

End Sub

Wrong 2

Private Sub Update_Click()

    Const cStrSheets As String = "Contractor Labor Summary, " _
        & "Material Summary, Company Labor, Forecast"

    Dim sh As Worksheet
    Dim vntSheets As Variant
    Dim i As Integer

    Application.ScreenUpdating = False

    vntSheets = Split(cStrSheets, ",")

    For i = 0 To UBound(vntSheets)
        For Each sh In Worksheets
            With sh
                If .Name <> vntSheets(0) And .Name <> vntSheets(1) And _
                        .Name <> vntSheets(2) And .Name <> vntSheets(3) Then
                    .Columns(1).ClearContents
                    .Range("A2").Value = "Project"
                    .Hyperlinks.Add Anchor:=.Range("A" & i + 3), Address:="", _
                            SubAddress:="'" & Trim(vntSheets(i)) _
                            & "'" & "!A1", TextToDisplay:=Trim(vntSheets(i))
                End If
            End With
        Next
    Next

    'ActiveWorkbook.Save

    Application.ScreenUpdating = True

End Sub

TinMan · Accepted Answer · 2018-12-27T21:03:25.507

1

Passing an array of worksheet names into Worksheets will return an array of Sheets that you can iterate over.

 For Each ws In ActiveWorkbook.Worksheets(Array("Contractor Labor Summary", "Material Summary", "Company Labor"))

Selecting or Activating objects should be avoided. It is best to refer to the cells directly.

Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)

Private Sub Update_Click()
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim n As Long

    For Each ws In ActiveWorkbook.Worksheets(Array("Contractor Labor Summary", "Material Summary", "Company Labor"))
        Dim cell As Range
        ws.Columns(1).ClearContents
        ws.Range("A2").Value = "Project"
        n = 0
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
                ws.Hyperlinks.Add Anchor:=ws.Range("A3").Offset(n), Address:="", SubAddress:="'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
                n = n + 1
            End If
        Next sh
    Next

    Application.ScreenUpdating = True
End Sub

edited Dec 27 '18 at 21:03

answered Dec 27 '18 at 20:26

TinMan

6,624
2
10
20

Have you tried this? The Anchor is pretty suspicious, it should be the cell where the hypelink is, and the sh.Name should be ws.Name if you're right about what the OP is trying to do. – VBasic2008 Dec 27 '18 at 20:56
@VBasic2008 Yes sir. I didn't want to repeat `ws.Range("A3").Offset(n)`; so I just referred to the cells in the range. – TinMan Dec 27 '18 at 20:59
@VBasic2008 I forgot to reset my counter `n`. I also removed the `With` statement when I realized that I could use `ws.Hyperlinks` instead of `ws.Range("A3").Offset(n).Hyperlinks`. – TinMan Dec 27 '18 at 21:05
This did exactly what i needed. thanks TinMan. I will look into how to avoid selecting or activation objects. – user10840423 Dec 27 '18 at 21:07
@user10840423 Glad that I could help. Thanks for accepting my answer. – TinMan Dec 27 '18 at 21:09
I got another wrong version. Now I get it. It was pretty unclear. Hats off. – VBasic2008 Dec 27 '18 at 21:25

James Igoe · Answer 3 · 2018-12-27T23:06:04.417

Since your core code repeats, you can create a separate method for that, and then as you iterate through your worksheets, set a worksheet object to the sheet, and then apply the code.

More accurately, you could create an array of sheet names, then loop the array, setting the worksheet object to each one, and then calling the code on it.

I didn't take a hard look at your code, but you might need to generalize and abstract your code a bit more, but the general rule is true.

Sub foo()

    Dim wks As Worksheet
    For Each wks In ThisWorkbook.Worksheets

        '''call to common method goes here 
        If... (sheet name matches one of several
            commonMethod(wks)
        End Iif 

    Next wks

End Sub

Sub commonMethod(wks As Worksheet)

    Dim sh As Worksheet
    Dim cell As Range

    wks.Activate
    wks.ClearContents
    wks.Range("A2").Value = "Project"
    wks.Range("A3").Select
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And     sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
            ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
        End If
    Next sh
End Sub

How to create and iterate an array:

''create string of sheets
Dim cStrSheets As String = "Contractor Labor Summary," _
    & "Material Summary,Company Labor,Forecast"   ' Worksheet List

''creates array from string
Dim arrSheets as variant = sp,it(cstrSheets,",")

Change the signature on the method th the following:

Sub commonMethod(wks As Worksheet, arrSheets as variant)

To replace this line:

If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast"

You can use something like this:

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

The new line would be:

If IsInArray(sh.Name, arrSheets) = false then

Hope that helps.

Thanks for the quick response. I'm not exactly sure how to enter the sheet name array into the code. I am 100% self-taught so please excuse my ignorance. Most of my codes are done by recording. — user10840423, Dec 27 '18 at 20:49

Is there a way to simplify this code? The code repeats on 3 sheets.

3 Answers3

Labor (Where Did I Go Wrong)

The Final Solution

Wrong 1

Wrong 2