Identify combined and individual user codes and divide them in seperate cells - VBA

[Jovannivk]

Hi all,

I'm working on something here, but I cannot figure out how to do this most efficiently (and effectively).

I have an input cell where I should insert my user codes. These codes are supposed to be changed into columns. However, within this cell I have two types of user codes. Ones where I want them to be combined and ones that i want separately. I thought perhaps the distinction of + and , could make the difference to recognize which ones should be combined and which not.



Input:
aaa001+aaa0001,bbb001+bbb0001,ccc001,ccc002
















Conditions:









- For combined codes (Identified by +):
[code1,code2]







- For single codes (identified by ,):
code 3



























Desired output:
[aaa001,aaa0001]
-
[bbb001,bbb0001]
-
ccc001
-
ccc002




I must install two conditions. The codes that has the + inbetween should be combined, and the input should look the following: [aaa001,aaa0001]. The codes with , in between can be taken seperately with just the code. Example: ccc002.

How can I create a macro that will recognize which ones to split and which ones to combine, and for the ones that should be combined to be in this format.

I am open to any ideas, thank you in advance. And yes the output must be in this format. Excel sheet is attached.

29665

[Paul_Hossler]

You didn't say where to put the output so I just put it the next cell

BTW, I unmerged the cell with the data since merged cells can be a little tricky

29667



Option Explicit


'aaa001+aaa0001,bbb001+bbb0001,ccc001,ccc002
'[aaa001,aaa0001] [bbb001,bbb0001] ccc001 ccc002


Sub DoCodes()
Dim r As Range, r1 As Range
Dim v As Variant
Dim i As Long

If Not TypeOf Selection Is Range Then Exit Sub


Set r = Nothing
On Error Resume Next
Set r = Selection.Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0

If r Is Nothing Then Exit Sub

For Each r1 In r.Cells
With r1
.Value = Trim(.Value)
If Len(.Value) = 0 Then GoTo NextCell

v = Split(.Value, ",")

For i = LBound(v) To UBound(v)
If InStr(v(i), "+") > 0 Then v(i) = "[" & v(i) & "]"
Next i

.Offset(0, 1).Resize(1, UBound(v) + 1).Value = v
End With

NextCell:
Next
End Sub

[Jovannivk]

You didn't say where to put the output so I just put it the next cell

BTW, I unmerged the cell with the data since merged cells can be a little tricky

29667



Option Explicit


'aaa001+aaa0001,bbb001+bbb0001,ccc001,ccc002
'[aaa001,aaa0001] [bbb001,bbb0001] ccc001 ccc002


Sub DoCodes()
Dim r As Range, r1 As Range
Dim v As Variant
Dim i As Long

If Not TypeOf Selection Is Range Then Exit Sub


Set r = Nothing
On Error Resume Next
Set r = Selection.Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0

If r Is Nothing Then Exit Sub

For Each r1 In r.Cells
With r1
.Value = Trim(.Value)
If Len(.Value) = 0 Then GoTo NextCell

v = Split(.Value, ",")

For i = LBound(v) To UBound(v)
If InStr(v(i), "+") > 0 Then v(i) = "[" & v(i) & "]"
Next i

.Offset(0, 1).Resize(1, UBound(v) + 1).Value = v
End With

NextCell:
Next
End Sub




Hi Paul,

Thank you very much for the help! I am not so familiar with this code my self so I do have to ask.

1. Is there a possibility that we run this code only for one cell (the input cell). Because when I run this macro, it messes up everything else in the sheet.
2. I notice you use offset to allocate the output. Is it also possible I could bring this another sheet "Sheet2" at a given range? let's say D5.

Thanks a lot anyways. You've helped me out a lot!

[arnelgp]

not so sophisticated but will work.
press Test Run button and select the input range and output cell (single cell).

[Paul_Hossler]

Option Explicit

'aaa001+aaa0001,bbb001+bbb0001,ccc001,ccc002
'[aaa001,aaa0001] [bbb001,bbb0001] ccc001 ccc002


Sub test()
Call DoCodes(Worksheets("test").Range("D2"), Worksheets("Sheet1").Range("D5"))
End Sub




Sub DoCodes(rIn As Range, rOut As Range)
Dim v As Variant
Dim i As Long

With rIn.Cells(1, 1)
.Value = Trim(.Value)
If Len(.Value) = 0 Then Exit Sub

v = Split(.Value, ",")

For i = LBound(v) To UBound(v)
If InStr(v(i), "+") > 0 Then v(i) = "[" & v(i) & "]"
Next i

End With

rOut.Cells(1, 1).Resize(1, UBound(v) + 1).Value = v
End Sub

[snb]

A tiny UDF in a separate macromodule suffices:


Function F_snb(c00)
st = Split(c00, ",")

For j = 0 To UBound(st)
If InStr(st(j), "+") Then st(j) = "[" & Replace(st(j), "+", ",") & "]"
Next

F_snb = st
End Function

Select G1:J1, enter =F_snb(C2), ctrl_shft_Enter