VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Susy · May 20th 2015

Hi there,

I would be very thankful if some could help me to write a small piece of code which does exactly the following:
in Row 1: dog cat fish dog mouse duck cat

Code

With CreateObject("Scripting.Dictionary")


For row = 1 to 40   '40 is the last column


If [the word does not exists] Then 
'do nothing and continue
Else
'add to the word the number 1 at the end
End if


Next


End With

Display More

Result
in Row 1: dog cat fish dog1 mouse duck cat1

I hope it is clear what I am trying to achieve.

Thanks

Susy · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

I forgot to mention that if word appears more than one time, then it should follow this logic, dog dog1 dog2 dog3 and so on... 1, 2, 3, n

**S O** · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Susy, I've added code tags for you on this occasion but please make sure you do this going forward.

You could try something like:

Code

With CreateObject("Scripting.Dictionary") 
     
    For row = 1 To 40 '40 is the last column
         
        If .Exists(Cells(row, 1).Value) Then 
             tempVal = Cells(row, 1).Value
             countVal = 1
             Do
                 If Not .Exists(tempVal & countVal) Then
                      .Add(tempVal & countVal)
                      Exit Do
                 Else
                      countVal = countVal + 1
                 End If
             Loop Until countVal = 40 '// Safety exit, maximum amount of rows
        Else 
             .Add(Cells(row, 1).Value)
        End If 
         
    Next 
     
End With

Display More

Susy · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Ooops, I meant columns.... like the heard of each column... in row 1

**S O** · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Just change the placement of the row variable in the Cells() argument. Although for the sake of logic you may want to rename that variable:

Code

With CreateObject("Scripting.Dictionary") 
     
    For col = 1 To 40 '40 is the last column
         
        If .Exists(Cells(1, col).Value) Then 
            tempVal = Cells(1, col).Value 
            countVal = 1 
            Do 
                If Not .Exists(tempVal & countVal) Then 
                    .Add(tempVal & countVal) 
                    Exit Do 
                Else 
                    countVal = countVal + 1 
                End If 
            Loop Until countVal = 40 '// Safety exit, maximum amount of cols
        Else 
            .Add(Cells(1, col).Value) 
        End If 
         
    Next 
     
End With

Display More

Susy · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Thanks for your code, but unfortunately it does not work.

it stops here...

Code

.Add (Cells(1, col).Value)

Thanks

**S O** · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Forgot you need a key, try something like:

Code

.Add Cells(1, col).Value, .Keys.Count + 1

Alternatively, use an ArrayList instead: http://www.ozgrid.com/forum/showthread.php?t=167349

Susy · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Thanks anyway. It does not work.

**S O** · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Code

With CreateObject("System.Collections.ArrayList") 
     
    For col = 1 To 40 '40 is the last column
         
        If .Contains(Cells(1, col).Value) Then 
            tempVal = Cells(1, col).Value 
            countVal = 1 
            Do 
                If Not .Contains(tempVal & countVal) Then 
                    .Add(tempVal & countVal) 
                    Exit Do 
                Else 
                    countVal = countVal + 1 
                End If 
            Loop Until countVal = 40 '// Safety exit, maximum amount of cols
        Else 
            .Add(Cells(1, col).Value) 
        End If 
         
    Next 
     
End With

Display More

Using an array list instead.

apo · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Susy..

Quote

Thanks anyway. It does not work.

Saying thanks is always good..

However.. From the point of view of debugging/testing.. "It does not work".. well.. that will not expedite a solution for you..

Also.. attaching a Sample Workbook usually increases your chance of help..

Susy · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Hi apo,

you are totally right. Sorry I did not provide a better description of the problem.

Just imagine a row with many different headers, let say 20 columns with headers... but some headers repeat themselves...

Dog Cat Fish Cat Horse Chicken Chicken Turkey Dog Cat

What I am trying to do is just to differentiate those words which repeat themselves with a number at the end of the word like

Dog Cat Fish Cat1 Horse Chicken Chicken1 Turkey Dog1 Cat2

Code

a = wksTemp.Cells(1).CurrentRegion.Value


    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For c = 1 To 36
            If Not .exists(a(1, c)) Then
            .Item(a(1, c)) = Array(a(1, c))
    '
            Else
                w = .Item(a(1, c))
                w(0) = w(0) + someCounter
                .item(a(1,c)) = w


    '
            End If
        Next c


And then         .keys()(c)
    
    End With

Display More

Unfortunately I don't know what else to do.

MickG · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Try:-

Code

Sub Rep()
Dim Rng As Range, Dn As Range
Set Rng = Range(Range("A1"), Cells(1, Columns.Count).End(xlToLeft))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.Value) Then
    .Add Dn.Value, 0
Else
    .Item(Dn.Value) = .Item(Dn.Value) + 1
    Dn.Value = Dn.Value & " " & .Item(Dn.Value)
End If
Next
End With
End Sub

Display More

Susy · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Hi MickG,

thanks for this code. It works like a charm.

Could you explain me how to read this line

Code

Dn.Value

and this one

Code

.Add Dn.Value, 0

and this one too.

Code

.Item(Dn.Value) = .Item(Dn.Value) + 1 
                Dn.Value = Dn.Value & " " & .Item(Dn.Value)

I am still learning. This is why it will also be very helpful to understand the code.

Thanks again

**KjBox** · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Try this, assumes Headers start in Cell A1

Code

Sub test()
    Dim x, i As Long, ii As Long
    
    With CreateObject("System.Collections.ArrayList")
        x = Cells(1).CurrentRegion.Rows(1)
        For i = 1 To UBound(x, 2)
            If .Contains(x(1, i)) Then
                ii = 1
                Do Until ii = UBound(x, 2)
                    If Not .Contains(x(1, i) & ii) Then
                        .Add (x(1, i) & ii): Exit Do
                     End If
                    ii = ii + 1
                Loop
            Else
                .Add x(1, i)
            End If
        Next
        Cells(1).CurrentRegion.Rows(1) = .toarray
    End With
    
End Sub

Display More

Edit: As I posted this I saw you already have a solution, this is an alternative method

Susy · May 20th 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Hi KjBox, thanks also for your code. Both codes are fantastic.

In case you have time, can you also explain me how to understand this:

Code

(x, 2)

, and this

Code

x(1, i)

, and this

Code

x(1, i) & ii

and finally this

Code

.toarray

Thanks in advance.

**KjBox** · May 21st 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

All the headers are load into an array (the variable x) then each element in the array is checked for duplication using the object ArrayList.

To do the check the code loops through each element in the array

Code

x(1, i)

is the ith element in the 2nd dimension of array x

Code

x(1, i) & ii

concatenates the value of the ith element of the 2nd dimension of array x and the variable ii

Code

.toarray

is a method used with the object ArrayList to transfer the list into an array.

To understand how arrays work in VBA google "Excel VBA arrays" and have an enjoyable read!

jindon · May 21st 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Code

Sub test()
    With Cells(1).CurrentRegion.Rows(1)
        .Value = Evaluate(.Address & "&if(countif(offset(" & .Address & ",,,,column(" & .Address & _
        "))," & .Address & ")>1,countif(offset(" & .Address & ",,,,column(" & .Address & _
        "))," & .Address & ")-1,"""")")
    End With
End Sub

MickG · May 21st 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Thank for the feedback, Hope this helps !!

Code

Sub Rep()
Dim Rng As Range, Dn As Range




'Rng set the first row of data as Range Object.
'NB:- as an Object the range will have "Properties & method"
'In this cae we are using its "Value" property
Set Rng = Range(Range("A1"), Cells(1, Columns.Count).End(xlToLeft))




'Create Dictionary
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare




'Loop through all Cells within the "Rng" Objects (that is all the data in row 1)
For Each Dn In Rng
 'Dn is also a range object and represents each value in thge Object "Rng", as you loop through the "Rng" (The First row).
 'Because we want the property "Value" of the Range object, we add ".Value" (The value property is the Default value, but always best to add it)
 
 'First Value found is "Dog". it is not already in the dictionary , so it is Added
    If Not .Exists(Dn.Value) Then
  'First Value "Dog" added
    .Add Dn.Value, 0 ' The 0 is the "item" (.item) of the Dictionary value "Dog"
    'and is the counter for How many Dogs" are found. Intially set to 0.




Else
   'The next Time "Dog" is found the code will pass to this point.
    'Now the item of "Dog" was 0 but as this is the second time it is found ,
    'we need to increase the count to "2"
    ' so as below the "1" is added  to the .item("Dog")(the Dn.value)
    .Item(Dn.Value) = .Item(Dn.Value) + 1
    
   'Now, this particular (Dn.value) is the second Item of "Dog" found and  can
   'be Concatenated the range object "Dn.value" with the new value of its ".item" "2"
   'So this now returns the value "Dog 2" to the second  value of "Dog" in the first row.
    Dn.Value = Dn.Value & " " & .Item(Dn.Value)
End If
Next
    'The preceeding account Happens for each Unique value found in Row 1.
    'You need to think of each Unique Value in the Dictionary and its ".item" (the count) as being
    'an individual Unique Value set within the dictionary with its own Individual Count.
End With
End Sub

Display More

Susy · May 21st 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Hi Jindon, thanks for your code.

as always, it works great. Thanks

Susy · May 21st 2015

Re: VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Hi MickG,

amazing. Thanks alot for this great comments on your code, wow... I know comments are not easy to write but they help us, the beginners.

Thanks for everything

VBA Dictionary ... if word in Row 1 already exits then "word"&"1"

Participate now!

Share