Reputation: 71
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
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