Sarah
Sarah

Reputation: 71

Calling Sub to all worksheets

I am new to VBA. I have been researching past codes to help me build my own.

my problem is that sub1 and sub2 work perfectly on their own. Sub1 goes through all the worksheets in the workbook while sub2 only works on the active workbook. Therefore, as I loop through the worksheets in sub1, I want to call sub2. The two subs are not related and therefore I do not have any inputs to use from sub1 to sub2.

Sub titles()
Dim titles() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim i As Long

Application.ScreenUpdating = False

Set wb = ActiveWorkbook


titles() = Array("Distance", "Count", "Fe %", "Cr %", "Fe (Mean)", "Fe (std)", "Cr (Mean)", "Cr(std)", "x", "Fe", "x", "Cr", "x", "Fe", "x", "Cr", "Fe W", "Fe A", "Cr W", "Cr A")

For Each ws In wb.Sheets

    With ws
    For i = 41 + LBound(titles()) To 41 + UBound(titles())

        .Cells(1, 1 + i).Value = titles(i - 41)

    Next i

    End With

 **Formulas ws**



Next ws


Application.ScreenUpdating = True

End Sub



**Public Sub Formulas(ws As Worksheet)**

**With ws**


   Dim R As Long
   Dim OutR1   As Long, OutR2 As Long, outRow As Long
   Dim MaxRow1 As Long, MaxRow2 As Long
   Dim SeriesFlag As Integer



   Range(Cells(2, "AX"), Cells(ActiveSheet.UsedRange.Rows.Count, "BE")).ClearContents

   R = 2

   outRow = 2

    Do Until Cells(R, "AP") = ""


   MaxRow1 = NextMaximumRow(R:=R, DataCol:=Range("AR1").Column, WMean:=Range("AT2"), WSErr:=Range("AU2"))


   If MaxRow1 > 0 Then

   Cells(outRow, Range("AX1").Column) = Cells(MaxRow1, "AP") ' x
   Cells(outRow, Range("AY1").Column) = Cells(MaxRow1, Range("AR1").Column)       ' y

   Cells(outRow, Range("AZ1").Column) = Cells(MaxRow1, "AP") ' x
   Cells(outRow, Range("BA1").Column) = 0       ' y

   R = R + 1

   outRow = outRow + 1
   End If



  If MaxRow1 = 0 Then
   R = R + 1
  End If



   R = R + 1

   Loop


   R = 2

   Do Until Cells(R, "AP") = ""



    MaxRow2 = NextMaximumRow(R:=R, DataCol:=Range("AS1").Column, WMean:=Range("AV2"), WSErr:=Range("AW2"))


    If MaxRow2 > 0 Then


   Cells(outRow, Range("AZ1").Column) = Cells(MaxRow2, "AP") ' x
   Cells(outRow, Range("BA1").Column) = Cells(MaxRow2, Range("AS1").Column)       ' y
   Cells(outRow, Range("AX1").Column) = Cells(MaxRow2, "AP") ' x
   Cells(outRow, Range("AY1").Column) = 0       ' y


    R = R + 1

   outRow = outRow + 1
   End If


  If MaxRow2 = 0 Then
   R = R + 1
  End If


   R = R + 1

   Loop

 Call Range("AX:BA").Sort(Key1:=Range("AX1"), Order1:=xlAscending, Header:=xlYes)


 R = 2
 OutR1 = 2
 OutR2 = 2

 Dim PeakRow1 As Long, PeakRow2 As Long

  ' Which series has the first Peak?


   PeakRow1 = NextPeakRow(R:=2, DataCol:=Range("AY1").Column)

   PeakRow2 = NextPeakRow(R:=2, DataCol:=Range("BA1").Column)

   If PeakRow1 < PeakRow2 And PeakRow1 > 0 Then
      Cells(OutR1, Range("BB1").Column) = Cells(PeakRow1, "AX") ' x
      Cells(OutR1, Range("BC1").Column) = Cells(PeakRow1, Range("AY1").Column)         ' y
      OutR1 = OutR1 + 1
      SeriesFlag = 2 ' next series to check
      R = PeakRow1

   ElseIf PeakRow2 > 0 Then
      Cells(OutR2, Range("BD1").Column) = Cells(PeakRow2, "AX") ' x
      Cells(OutR2, Range("BE1").Column) = Cells(PeakRow2, Range("BA1").Column)         ' y
      OutR2 = OutR2 + 1
      SeriesFlag = 1 ' next series to check
      R = PeakRow2

    ElseIf PeakRow2 = 0 Then
    SeriesFlag = 1
    R = PeakRow2 + 1

    ElseIf PeakRow1 = 0 Then
    SeriesFlag = 2
    R = PeakRow1 + 1

   Else
      MsgBox "There is no Peak"
      Exit Sub
   End If

   R = R + 1

   Do Until Cells(R, "AP") = ""

      Select Case SeriesFlag

         Case 1

            PeakRow1 = NextPeakRow(R:=R, DataCol:=Range("AY1").Column)
            If PeakRow1 > 0 Then
      Cells(OutR1, Range("BB1").Column) = Cells(PeakRow1, "AX") ' x
      Cells(OutR1, Range("BC1").Column) = Cells(PeakRow1, Range("AY1").Column)         ' y
      OutR1 = OutR1 + 1
      SeriesFlag = 2
      R = PeakRow1

            End If

         Case 2

            PeakRow2 = NextPeakRow(R:=R, DataCol:=Range("BA1").Column)
           If PeakRow2 > 0 Then
      Cells(OutR2, Range("BD1").Column) = Cells(PeakRow2, "AX") ' x
      Cells(OutR2, Range("BE1").Column) = Cells(PeakRow2, Range("BA1").Column)         ' y
      OutR2 = OutR2 + 1
      SeriesFlag = 1 ' next series to check
      R = PeakRow2

            End If

         Case Else
            Stop

      End Select

      R = R + 1

   Loop

 **End With**

 End Sub

Upvotes: 0

Views: 339

Answers (1)

chris neilsen
chris neilsen

Reputation: 53166

General structure you need is

Sub Sub1()
    Dim ws As Worksheet
    For Each ws In wb.Sheets
        ' other code
        Sub2 ws
    Next
End Sub

Sub Sub2(ws as Worksheet)
    ' work with ws object
    ' eg
    With ws
        .Cells(11, 1).Formula = "=Sum(A1:A10)"
    End With
End Sub

Upvotes: 3

Related Questions