Help with Scripting.Dictionary

[Nalani]

I am trying to shorten this part of my code with what I searched and thought could be done.

From this:

With CreateObject("Scripting.Dictionary")
          .CompareMode = vbTextCompare
          For i = 1 To UBound(a, 1)
               z = a(i, 1) & ";" & a(i, 2) & ";" & a(i, 3) & ";" & a(i, 4) _
                & a(i, 5) & ";" & a(i, 6) & ";" & a(i, 7) & ";" & a(i, 8)

To This:

For ii = 1 To UBound(a, 2): z = a(i, ii) & ";":  Next

The error I'm getting is "Subscript out of range" with the : Next highlighted.

What am I missing (or have wrong) in that line?

Thanks for looking.

 

[xenou]

You should be sure the array is in fact 1-based and not 0-based. Perhaps posted the entire code block with both i and ii loops shown.

Note that probably you require not:
z = a(i,ii) & ";"

but
z = z & a(i,ii) & ";"

Being sure to set z = "" at the start of each (inner) loop.

 

[Nalani]

Thanks for the look xenou

This is where I started:

Sub ChangeColor1()
Dim a, i As Long, z As String, myColor As Byte
With ActiveSheet
    .Cells.Interior.ColorIndex = xlNone
     a = Intersect(.Range("A:H"), .UsedRange).Value
     myColor = 2
     With CreateObject("Scripting.Dictionary")
          .CompareMode = vbTextCompare
          For i = 1 To UBound(a, 1)
               z = a(i, 1) & ";" & a(i, 2) & ";" & a(i, 3) & ";" & a(i, 4) _
                & a(i, 5) '& ";" & a(i, 6) & ";" & a(i, 7) & ";" & a(i, 8)

What I'm tring to do is cut down the repetitive & ";"& a(i,col #) if I have more columns to add.

I am refering to this thread that I am trying to adapt
http://www.mrexcel.com/forum/showthread.php?t=257317&page=3

With this part of code:

For ii = 1 To UBound(a, 2): z = a(i, ii) & ";":  Next

What follows in my code is identicle to the link posted.

I'm trying to Identify dupes, trips, quads, etc. with different colors, for each. Then I can decide which to delete after reviewing info in cells after Col H.

 

[xenou]

It looks alright to me what you are doing (if a bit awkward for 8+ columns). You will still have to post your full set of For-Next blocks - I don't see any syntax errors in what you've shown but it's not the complete code block.

 

[Nalani]

Thanks for the replies xenou.

Got me thinking to what I was actually doing. I had mistakenly deleted a line of code that was needed. And needed to reset z to "".

Final code that works:

Sub ChangeColor()
Dim a, i As Long, ii As Long, z As String, myColor As Byte
With ActiveSheet
    .Cells.Interior.ColorIndex = xlNone
     a = Intersect(.Range("A:H"), .UsedRange).Value
     myColor = 2
     With CreateObject("Scripting.Dictionary")
          .CompareMode = vbTextCompare
     For i = 1 To UBound(a, 1)  ' had delleted this by mistake
          For ii = 1 To UBound(a, 2): z = z & a(i, ii) & ";":   Next
              If Not .exists(z) Then
                    myColor = myColor + 1
                    If myColor > 56 Then myColor = 2
                    .Add z, Array(i, myColor)
               Else
                    ActiveSheet.Rows(i).Interior.ColorIndex = Val(.Item(z)(1))
                    If .Item(z)(0) <> "" Then
                       ActiveSheet.Rows(.Item(z)(0)).Interior.ColorIndex = Val(.Item(z)(1))
                         .Item(z)(0) = ""
                    End If
               End If
               z = ""   ' needed to add this line
               Next
     End With
End With
End Sub