Excel VBA to extract part of string and concatenate them with "," (Unique values only

mchilapur · Jul 4th 2016

Dear all,

In the data available in attachment, i am trying to extract starting 3 letters of each cell value and add only UNIQUE values with ',' separator.

I tried to find logic with below code but i know it fails.
Can anyone please help me to correct it or provide fresh code to achieve the intent.
Output required is as shown in the attachment.

Many thanks.

Just in order to get best possible solution, this querry is cross posted @
http://www.excelforum.com/showthread.php?t=1146299&p=4425730#post4425730

Code

Option Explicit


Sub extractpC()
    Dim pc As String
    Dim pc1 As String
    Dim pcDiv1 As String
    Dim cell As Range
    
    pc1 = ""
    
     For Each cell In ActiveSheet.Range("A2", ActiveSheet.Cells(Rows.Count, "A").End(xlUp))
     
            pc = Left(cell.Value, 3)
                        'MsgBox pc
                    If pc1 = "" Then
                        pc1 = pc
                        ElseIf pc = pc1 Then
                            pcDiv1 = pc1
                            Else: pcDiv1 = pc & "," & pc1
                     End If
'                pcDiv1 = pcDiv1 + pcDiv1
        End If
    Next cell
    MsgBox pcDiv1
End Sub

Display More

**StephenR** · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

Here is one way:

Code

Sub Macro2()


Dim r As Range


Application.ScreenUpdating = False


Set r = Range("A1").CurrentRegion
r.Offset(, 1).Resize(1).Value = "x"
r.Offset(1, 1).Resize(r.Rows.Count - 1).FormulaR1C1 = "=LEFT(RC[-1],3)"
r.Offset(, 1).Resize(r.Rows.Count).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r.Offset(, 2), Unique:=True
r(4, 6).Value = Join(Application.Transpose(Range("C2", Range("C" & Rows.Count).End(xlUp))), ", ")
r.Offset(, 1).Resize(, 2).Clear


Application.ScreenUpdating = True


End Sub

Display More

mchilapur · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

Thanks for your response..
I want this value to be stored as a variable..I am upto the below code, but i am failing to pull UNIQUE values.
Can anyone please help..?

Code

Sub test()Dim aa As String
Dim dd As Variant




For Each cell In ActiveSheet.Range("A2", ActiveSheet.Cells(Rows.Count, "A").End(xlUp))
If cell.Value <> "" Then
    aa = Left(cell.Value, 3)
    If dd = Empty Then
        dd = aa
            'ElseIf InStr(aa, dd) Then
            ElseIf Not IsError(Application.Match(aa, dd, 0)) Then
            GoTo iteration:
            Else: dd = dd & "," & aa




    End If
  End If




iteration:
Next cell
End Sub

Display More

**StephenR** · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

Just store it in a variable then instead of the sheet

Code

Sub Macro2() 
     
    Dim r As Range, s as string
     
    Application.ScreenUpdating = False 
     
    Set r = Range("A1").CurrentRegion 
    r.Offset(, 1).Resize(1).Value = "x" 
    r.Offset(1, 1).Resize(r.Rows.Count - 1).FormulaR1C1 = "=LEFT(RC[-1],3)" 
    r.Offset(, 1).Resize(r.Rows.Count).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r.Offset(, 2), Unique:=True 
   s = Join(Application.Transpose(Range("C2", Range("C" & Rows.Count).End(xlUp))), ", ") 
    r.Offset(, 1).Resize(, 2).Clear 
     
    Application.ScreenUpdating = True 
     
End Sub

Display More

**StephenR** · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

Cross-post http://www.excelforum.com/exce…g-exists-in-an-array.html

Please read the forum rules about cross-posting. By not adding links you are potentially wasting the time of volunteers here (in this case me). Please don't do it again.

**StephenR** · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

This will work IF your data are sorted before running

Code

Sub extractpC()
    
    Dim pc As String
    Dim pc1 As String
    Dim pcDiv1 As String
    Dim cell As Range
     
    pc1 = ""
     
    For Each cell In ActiveSheet.Range("A2", ActiveSheet.Cells(Rows.Count, "A").End(xlUp))
        pc = Left(cell.Value, 3)
        If pc1 = "" Then
            pcDiv1 = pc
        ElseIf pc <> pc1 Then
            pcDiv1 = pcDiv1 & "," & pc
        End If
        pc1 = pc
    Next cell
    
MsgBox pcDiv1


End Sub

Display More

Your logic is wrong because, among other things, you were comparing pc only with the previous value of pc1.

sktneer · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

Will this work for you?

Code

Sub GetUniqueStrings()
Dim dict As Object
Dim lr As Long, i As Long
Dim x
Dim UniqueString As String    'Variable to store unique values


lr = Cells(Rows.Count, 1).End(xlUp).Row
x = Range("A2:A" & lr).Value


Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(x, 1)
   dict.Item(Left(x(i, 1), 3)) = ""
Next i
UniqueString = Join(dict.keys, ",")
MsgBox UniqueString
End Sub

Display More

mchilapur · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

Hello Stephen,
Now i realized by mistake...Thanks your code..:)
And sorry for cross-posting..I am not among those who just put in their concern and let others work on it..
I try to understand the logic and realize where i commit mistake..

Your code still make "ALS" as duplicate entry....

I think it still requires modification..Please help..

mchilapur · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

sktneer..Yes your codes works perfectly..:) Thanks for your response..

Can you please help me to correct previous code..?
Is it possible to check if pc<>pcDiv1 instead of pc<>pc1..?

Anyhow this thread is solved..:)

Code

pc <> pc1]Then
 pcDiv1 = pcDiv1 & "," & pc

**StephenR** · Jul 4th 2016

Re: Excel VBA to extract part of string and concatenate them with "," (Unique values

Did you read my comment about sorting the data first?

Excel VBA to extract part of string and concatenate them with "," (Unique values only

Participate now!

Share