count colors on sheet using cell value as sheet name

[BRB1983]

i have a code that counts colors on a sheet. Colors blue and Yellow. The code is on each sheet it works on. i like to modify it to work off a module and use a cell value to call what sheet to use.here is the working code from sheet:

Public Sub DEISOBUTANIZER()
  Dim db As Object, dy As Object
  Dim A As Variant
  Dim i As Long, j As Long, uba2 As Long, lr As Long, lc As Long, lbluecounter As Long, lyellowcounter As Long
 
  Set dy = CreateObject("Scripting.Dictionary")
  Set db = CreateObject("Scripting.Dictionary")
  With Sheets("Circulation")
    A = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Value
    For i = 1 To UBound(A)
      db(A(i, 1)) = Empty
    Next i
  End With
    With Sheets("final")
    A = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Value
    For i = 1 To UBound(A)
      dy(A(i, 1)) = Empty
    Next i
  End With
  With Sheet58
    lr = .Columns("b:Z").Find(what:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lc = .Rows("2:1633").Find(what:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    A = .Range("b2").Resize(lr - 1, lc - 2).Value
  End With
  uba2 = UBound(A, 2)
  For i = 1 To UBound(A)
    For j = 1 To uba2
      If Not IsEmpty(A(i, j)) Then
  If dy.exists(A(i, j)) Then
    lyellowcounter = lyellowcounter + 1
  ElseIf db.exists(A(i, j)) Then
    lbluecounter = lbluecounter + 1
  End If
End If
    Next j
  Next i
  With Sheets("Status")
    .Range("C12") = lbluecounter
    .Range("B12") = lyellowcounter
  End With
End Sub

here is the code on module that i tried.

Public Sub DEISOBUTANIZER()
Dim rng As Range
Dim cell As Range
Set rng = Sheet17.Range("A6:A100")
For Each cell In rng
If cell <> "" Then

Dim strsheetname As String
strsheetname = cell.Value

  Dim db As Object, dy As Object
  Dim A As Variant
  Dim i As Long, j As Long, uba2 As Long, lr As Long, lc As Long, lbluecounter As Long, lyellowcounter As Long
 
  Set dy = CreateObject("Scripting.Dictionary")
  Set db = CreateObject("Scripting.Dictionary")
  With Sheets("Circulation")
    A = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Value
    For i = 1 To UBound(A)
      db(A(i, 1)) = Empty
    Next i
  End With
    With Sheets("final")
    A = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Value
    For i = 1 To UBound(A)
      dy(A(i, 1)) = Empty
    Next i
  End With
  With strsheetname
    lr = .Columns("b:Z").Find(what:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lc = .Rows("2:1633").Find(what:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    A = .Range("b2").Resize(lr - 1, lc - 2).Value
  End With
  uba2 = UBound(A, 2)
  For i = 1 To UBound(A)
    For j = 1 To uba2
      If Not IsEmpty(A(i, j)) Then
  If dy.exists(A(i, j)) Then
    lyellowcounter = lyellowcounter + 1
  ElseIf db.exists(A(i, j)) Then
    lbluecounter = lbluecounter + 1
  End If
End If
    Next j
  Next i
  cell.Offset(0, 1) = lyellowcounter
  cell.Offset(0, 2) = lbluecounter
  End If
  Next
'  With Sheets("Status")
'    .Range("C12") = lbluecounter
'    .Range("B12") = lyellowcounter
'  End With
End Sub

I get error that strsheetname needs to be dimmed as variant or ojbject.

I tried dim it to variant and then I get error 424 on line:

With strsheetname

 

[Fluff]

Keep it as a string & use it like

With Sheets(strsheetname)

 

[BRB1983]

Ok that works now but when it goes to the next sheet it adding all the colors. Can i clear the counters when it starts on the next sheet?

 

[BRB1983]

this worked thanks for the help

With Sheets(strsheetname)
  lbluecounter = 0
  lyellowcounter = 0

 

[Fluff]

Just set the counters back to zero, at the end of the loop.