count colors on sheet using cell value as sheet name

BRB1983

Board Regular
Joined
Aug 29, 2019
Messages
61
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:

VBA Code:
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.
Code:
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
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,642
Office Version
  1. 365
Platform
  1. Windows
Keep it as a string & use it like
VBA Code:
With Sheets(strsheetname)
 

BRB1983

Board Regular
Joined
Aug 29, 2019
Messages
61
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

Board Regular
Joined
Aug 29, 2019
Messages
61
this worked thanks for the help
VBA Code:
With Sheets(strsheetname)
  lbluecounter = 0
  lyellowcounter = 0
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,642
Office Version
  1. 365
Platform
  1. Windows
Just set the counters back to zero, at the end of the loop.
 

Forum statistics

Threads
1,143,676
Messages
5,720,242
Members
422,272
Latest member
ginkgoVil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top