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 tried dim it to variant and then I get error 424 on line:

With strsheetname