I have the following code to loop thru the Parts,Pipe and Misc Sheet rows and get the quantities from the RF sheets.

Sub GetQuantity()

Dim ws As Worksheet
Dim x As Long, c As Long, lLastRow As Long
Dim wsString As String
Dim wnCntr As Long

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "Parts" Or ws.Name = "Pipe" Or ws.Name = "Misc" Then
Set wsSheet = Worksheets(ws.Name)
lLastRow = Sheets(ws.Name).Cells(Sheets(ws.Name).Rows.Count, "B").End(xlUp).Row

For x = 1 To lLastRow

If Left(Range("B" & x).Value, 3) <> "Par" And Left(Range("B" & x).Value, 3) <> "Sto" Then
wsString = Range("B" & x).Value


QtyWs wsString, wnCntr

Worksheets(ws.Name).Range("F" & x).Value = wnCntr
wnCntr = 0
End If

Next x
End If

Next ws

End Sub

Sub QtyWs(wsString As String, wnCntr As Long)

Dim ws As Worksheet
Dim xx As Long, llLastRow As Long

For Each ws In ActiveWorkbook.Worksheets

If ws.Name Like "*" & "RF" & "*" Then
llLastRow = Sheets(ws.Name).Cells(Sheets(ws.Name).Rows.Count, "B").End(xlUp).Row

For xx = 1 To llLastRow
If Range("B" & xx).Value = wsString Then
wnCntr = wnCntr + Range("F" & xx).Value
End If

Next xx
End If
Next ws


End Sub

The issue is that it is always coming back as 0 on the 3 sheets but seems to be updating the RF sheets - can't see the issue at the moment, are you able to help

I have the following code to loop thru the Parts,Pipe and Misc Sheet rows and get the quantities from the RF sheets.

Sub GetQuantity()

Dim ws As Worksheet
Dim x As Long, c As Long, lLastRow As Long
Dim wsString As String
Dim wnCntr As Long

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "Parts" Or ws.Name = "Pipe" Or ws.Name = "Misc" Then
Set wsSheet = Worksheets(ws.Name)
lLastRow = Sheets(ws.Name).Cells(Sheets(ws.Name).Rows.Count, "B").End(xlUp).Row

For x = 1 To lLastRow

If Left(Range("B" & x).Value, 3) <> "Par" And Left(Range("B" & x).Value, 3) <> "Sto" Then
wsString = Range("B" & x).Value


QtyWs wsString, wnCntr

Worksheets(ws.Name).Range("F" & x).Value = wnCntr
wnCntr = 0
End If

Next x
End If

Next ws

End Sub

Sub QtyWs(wsString As String, wnCntr As Long)

Dim ws As Worksheet
Dim xx As Long, llLastRow As Long

For Each ws In ActiveWorkbook.Worksheets

If ws.Name Like "*" & "RF" & "*" Then
llLastRow = Sheets(ws.Name).Cells(Sheets(ws.Name).Rows.Count, "B").End(xlUp).Row

For xx = 1 To llLastRow
If Range("B" & xx).Value = wsString Then
wnCntr = wnCntr + Range("F" & xx).Value
End If

Next xx
End If
Next ws


End Sub

The issue is that it is always coming back as 0 on the 3 sheets but seems to be updating the RF sheets - can't see the issue at the moment, are you able to help

• excel
• vba
• loops

• 2 Range("B" & xx).Value needs to be qualified with the worksheet. Same goes for other instances of Range. – BigBen Commented 5 hours ago
• as for "updating the RF sheets": check If ws.Name Like "" & "RF" & "" Then... – Docuemada Commented 5 hours ago
• I think @BigBen has got the answer in his comment. Just want to add that you can remove the Set wsSheet = Worksheets(ws.Name) line - it isn't used anywhere. – Darren Bartrup-Cook Commented 5 hours ago
• @DarrenBartrup-Cook or wsSheet could be used to qualify the Range hehehe. – BigBen Commented 5 hours ago
• 1 @DarrenBartrup-Cook oops, good point! Didn't read carefully. – BigBen Commented 4 hours ago

2 Answers 2

So, you missed the worksheet qualifier in some places:

Option Explicit

Sub GetQuantity()
  Dim ws As Worksheet, wsString As String
  Dim x As Long, c As Long, lLastRow As Long
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = "Parts" Or ws.Name = "Pipe" Or ws.Name = "Misc" Then
      lLastRow = ws.[B1000000].End(xlUp).Row
      For x = 1 To lLastRow
        wsString = Left(ws.Cells(x, "B").Value, 3)
        If wsString <> "Par" And wsString <> "Sto" Then
          ws.Cells(x, "F").Value = QtyWs(ws.Cells(x, "B").Value)
        End If
      Next x
    End If
  Next ws
End Sub

Function QtyWs(ByVal wsString As String) As Long
  Dim ws As Worksheet, llLastRow As Long, wnCntr As Long
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "*" & "RF" & "*" Then
      llLastRow = ws.[B1000000].End(xlUp).Row
      wnCntr = wnCntr + Application.SumIf(ws.[B1].Resize(llLastRow), _
        "=" & wsString, ws.[F1].Resize(llLastRow))
    End If
  Next ws
  QtyWs = wnCntr
End Function

Consider using the worksheet functionSUMIF()

Function QtyWs(s As String) As Long
    Dim ws As Worksheet, rngB As Range, rngF As Range
    
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "*" & "RF" & "*" Then
            Set rngB = ws.Range("B:B")
            Set rngF = ws.Range("F:F")
            QtyWs = QtyWs + WorksheetFunction.SumIf(rngB, s, rngF)
        End If
    Next
    
End Function

Sub GetQuantity()

    Dim ws As Worksheet, lastRow As Long, r As Long, s As String
   
    For Each ws In ActiveWorkbook.Worksheets
        Select Case ws.Name
            Case "Parts", "Pipe", "Misc"
            
                lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
                For r = 1 To lastRow
                     s = ws.Cells(r, "B")
                     If Left(s, 3) = "Par" Or Left(s, 3) = "Sto" Then
                        ' skip
                     Else
                        ws.Cells(r, "F") = QtyWs(s)
                     End If
                 Next r
        End Select
    Next ws
    MsgBox "Count complete"

End Sub