Concatenate (join cell values) based on other cell values

P

paneliyadhruv

New Member
Joined
May 21, 2018
Messages
36
Dear all experts,

I need help to move the range of input and output.
In column B start No and column C end number. Based on first macro i am able to generate serial number with common prefix from columns K to AI.

Similarly, column D start No and column E end number. Based on second macro i am able to generate serial number with common prefix from columns AL to BJ.

Now as per my requirement is to concatenate (join) the same column value based on values present in column G and H for serial No. 1 and 2, respectively.

Macro 3 used to concatenate (join) the cell value based on value present on G4 of column K and output in column - BM (need help to move range down and output from columns BN to CK based on value in column G5 to end).
Macro 4 used to concatenate (join) the cell value based on value present on H4 of column AL and output in column CN (need help to move range down and output from columns CO to DL based on value in column H5 to end).

If number generation and concatenate work together then no need to generate series.

Please find worksheet with highlighted color for each sequence of input and output.

Thank you very much in advance.

Code: 
Sub No_serial_1()With Worksheets("Sheet1")
    .Activate
Dim rng As Range, d As Range, cel As Range
Dim addStr As String
Set rng = Sheet1.Range([B4], Cells(Rows.Count, "B").End(xlUp))
addStr = Sheet1.Range("A4:A4")
Set d = [j1]
For Each cel In rng
    Set d = d(1, 2)
    d = cel
    d.AutoFill d.Resize(cel(1, 2) - cel + 1), xlFillSeries
    d.Resize(cel(1, 2)).NumberFormat = addStr & 0
Next
End With
End Sub


Sub No_serial_2()
With Worksheets("Sheet1")
    .Activate
Dim rng As Range, d As Range, cel As Range
Dim addStr As String
Set rng = Sheet1.Range([D4], Cells(Rows.Count, "D").End(xlUp))
addStr = Sheet1.Range("A4:A4")
Set d = [AK1]
For Each cel In rng
    Set d = d(1, 2)
    d = cel
    d.AutoFill d.Resize(cel(1, 2) - cel + 1), xlFillSeries
    d.Resize(cel(1, 2)).NumberFormat = addStr & 0
Next
End With
End Sub
Sub Concatenate_No_serial_1()
'for concatenate serail No 1
On Error Resume Next


With Sheet1
    .Activate


Dim r As Long, lr As Long, nr As Long, qr As Long
Dim L&


L = Sheet1.Range("G4")
If L = 2 Then


lr = Sheet1.Cells(Rows.Count, 11).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 65) = Cells(r, 11).Text & ", " & Cells(r + 1, 11).Text 'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else
If L = 3 Then


lr = Sheet1.Cells(Rows.Count, 11).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 65) = Cells(r, 11).Text & ", " & Cells(r + 1, 11).Text & ", " & Cells(r + 2, 11).Text   'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else


If L = 4 Then


lr = Sheet1.Cells(Rows.Count, 11).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 65) = Cells(r, 11).Text & ", " & Cells(r + 1, 11).Text & ", " & Cells(r + 2, 11).Text & ", " & Cells(r + 3, 11).Text  'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else


If L = 5 Then


lr = Sheet1.Cells(Rows.Count, 11).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 65) = Cells(r, 11).Text & ", " & Cells(r + 1, 11).Text & ", " & Cells(r + 2, 11).Text & ", " & Cells(r + 3, 11).Text & ", " & Cells(r + 4, 11).Text 'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else


lr = Sheet1.Cells(Rows.Count, 11).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step 1
  nr = nr + 1
  Sheet1.Cells(nr, 65) = Cells(r, 11).Text '& ", " & Cells(r + 1, 65) & ", " & Cells(r + 2, 65) 'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Sheet3.Columns(65).AutoFit


End If
End If
End If
End If
End With
End Sub


Sub Concatenate_No_serial_2()
'for concatenate serail No 2
On Error Resume Next


With Sheet1
    .Activate


Dim r As Long, lr As Long, nr As Long, qr As Long
Dim L&


L = Sheet1.Range("H4")
If L = 2 Then


lr = Sheet1.Cells(Rows.Count, 38).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 92) = Cells(r, 38).Text & ", " & Cells(r + 1, 38).Text 'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else
If L = 3 Then


lr = Sheet1.Cells(Rows.Count, 38).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 92) = Cells(r, 38).Text & ", " & Cells(r + 1, 38).Text & ", " & Cells(r + 2, 38).Text   'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else


If L = 4 Then


lr = Sheet1.Cells(Rows.Count, 38).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 92) = Cells(r, 38).Text & ", " & Cells(r + 1, 38).Text & ", " & Cells(r + 2, 38).Text & ", " & Cells(r + 3, 38).Text  'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else


If L = 5 Then


lr = Sheet1.Cells(Rows.Count, 38).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 92) = Cells(r, 38).Text & ", " & Cells(r + 1, 38).Text & ", " & Cells(r + 2, 38).Text & ", " & Cells(r + 3, 38).Text & ", " & Cells(r + 4, 38).Text 'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else


lr = Sheet1.Cells(Rows.Count, 38).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step 1
  nr = nr + 1
  Sheet1.Cells(nr, 92) = Cells(r, 38).Text '& ", " & Cells(r + 1, 65) & ", " & Cells(r + 2, 65) 'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Sheet3.Columns(92).AutoFit


End If
End If
End If
End If
End With
End Sub
 
Last edited:

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
I am unable to upload file.
So some more details as below.

Common prefix in cell A4 (eg. AA)
Numerical value (start and end) B4 to C28 for serial No. 1 and D4 to E28 for serial No 2.
No of times values of one columns need tobe concatenate is G4 to G28 (eg 1 to 5 random) and H4 to H28, respectively.

Output each column in separate column from BM to 25 columns for series No.1 and CN to till 25 columns for series No 2.
 
Upvote 0
Simple explanation of requirement: Cell A4 having common prefix (eg. AA), B4 having start no (eg. 101), C4 having end no (eg. 120). G4 having no (eg. 2). Now sequence of result as first to generate number sequence from 101 to 120 with common prefix (eg. AA101, AA102 till AA120) then concatenate or join AA101, AA102 and AA103, AA104 till AA119, AA120 based on values present in G4. Similarly B5 and C5 having start and end no for corresponding no of cells to be concatenate in G5. total 25 row from B to C, G column. Output of each series in separate column from K onward.
 
Upvote 0
I think it looks very complicate to understand. So, I need help, how include range G4 to G28 (based on this cells to combine for each row of single column) and input range columns K to AI in below macro. Output in columns BM to CK or in same column K to AI.

Code: 
Sub Concatenate_No_serial_11()'for concatenate serail No 1
On Error Resume Next


With Sheet1
    .Activate


Dim r As Long, lr As Long, nr As Long, qr As Long
Dim L&


L = Sheet1.Range("G4")
If L = 2 Then


lr = Sheet1.Cells(Rows.Count, 11).End(xlUp).Row 'lr = Sheet2.Cells(Rows.Count, change column input).End(xlUp).Row
For r = 1 To lr Step L
  nr = nr + 1
  Sheet1.Cells(nr, 65) = Cells(r, 11).Text & ", " & Cells(r + 1, 11).Text 'Sheet3.Cells(nr, change column output) =Cells(r, change column input) & ", " & Cells(r + 1, change column input)
  If Right(Sheet1.Cells(nr, 2), 1) = "," Then
    Sheet1.Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Else


End If
End With
End Sub
 
Upvote 0
For code
Code: 
[COLOR=#333333]L = Sheet1.Range("G4")[/COLOR]
need to include G4 to G28
for code
Code: 
[COLOR=#333333]lr = Sheet1.Cells(Rows.Count, 11).End(xlUp).Row[/COLOR]
need to include columns K to AI. Output of each range in separate columns.

Thank you very much for your time and help in advance.
 
Upvote 0
As you have found, you cannot attach a file. My signature block below has some links with help on how to post small sets of dummy data. That might be very helpful because after reading through your posts I am quite confused about what is where and exactly what you are trying to achieve. I have based my attempt below on what I think post 3 is asking.

Code: 
Sub Concat_Items()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, strt As Long, stp As Long, grp As Long
  Dim pref As String, s As String
  
  With Range("A4", Range("G" & Rows.Count).End(xlUp))
    a = Application.Index(.Value, Evaluate("Row(1:" & .Rows.Count & ")"), Array(1, 2, 3, 7))
  End With
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    pref = a(i, 1)
    strt = a(i, 2)
    stp = a(i, 3)
    grp = a(i, 4)
    s = vbNullString
    For j = strt To stp
      s = s & IIf((j - strt + 1) Mod grp = 1, ";", ", ") & pref & j
    Next j
    b(i, 1) = Mid(s, 2)
  Next i
  With Range("K4").Resize(UBound(b))
    .Value = b
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Other:=False
  End With
End Sub


Based on original data in columns A:G below, the above code produced what is in columns K:O
Hopefully that is at least heading in the right direction.


Book1
ABCDEFGHIJKLMNO
4AA1011102AA101, AA102AA103, AA104AA105, AA106AA107, AA108AA109, AA110
5BC971053BC97, BC98, BC99BC100, BC101, BC102BC103, BC104, BC105
Sheet3
 
Upvote 0
Dear Sir,

Happy to see you again.

I need result in columns for each range. Details as below.
A4 -AA, B4 -101, C4 -110 and G4-2 then K to O result in column K
A5-BC, B5-97, C5-105 AND G5-3 then K to M result in column L
till
row 28 (means value present till A28, B28, C28 AND G28). IF G column value is 1 the only prefix without any concatenate.

Thank you very much sir.
 
Upvote 0
paneliyadhruv said:
Output of each series in separate column from K onward.
Click to expand...
paneliyadhruv said:
A4 -AA, B4 -101, C4 -110 and G4-2 then K to O result in column K
Click to expand...
:confused: These seem to contradict each other.


paneliyadhruv said:
Details as below.
A4 -AA, B4 -101, C4 -110 and G4-2 then K to O result in column K
A5-BC, B5-97, C5-105 AND G5-3 then K to M result in column L
till
row 28 (means value present till A28, B28, C28 AND G28). IF G column value is 1 the only prefix without any concatenate.
Click to expand...
Please show some sample data like that and the expected results. Notice how easy it is for you to see exactly what I have and where with my screen shot. Refer to my previous post for how to do this. Only need 4 or 5 rows but make sure one of those rows only has a 1 in column G it it sounds like that might be a bit different to the other situations.
 
Upvote 0
Data


Book1
ABCDEFG
1
2
3PrefixStart NoEnd NoValue for No of times generated series oncatenate
4AA1011101
5BC1111203
6D1211302
7E1311402
8F1411504
9G1511604
10H1611702
11I1711803
12J1811904
13K1912001
14L2012102
15M2112203
16N2212301
17O2312402
18P2412503
19Q2512602
20R2612702
21S2712802
22T2812902
23U2913002
24V3013102
25W3113202
26X3213302
27Y3313402
28Z3413502
29
Sheet1


Output


Book1
KLMNOPQRSTUVWXYZ
1AA101BC111, BC112, BC113D121, D122E131, E132F141, F142, F143, F144G151, G152, G153, G154H161, H162I171, I172, I173J181, J182, J183, J184K191L201, L202M211, M212, M213N221O231, O232P241, P242, P243so on till last range
2AA102BC114, BC115, BC116D123, D124E133, E134F145, F146, F147, F148G155, G156, G157, G158H163, H164I174, I175, I176J185, J186, J187, J188K192L203, L204M214, M215, M216N222O233, O234P244, P245, P246
3AA103BC117, BC118, BC119D125, D126E135, E136F149, F150G159, G160H165, H166I177, I178, I179J189, J190K193L205, L206M217, M218, M219N223O235, O236P247, P248, P249
4AA104BC120D127, D128E137, E138H167, H168I180K194L207, L208M220N224O237, O238P250
5AA105D129, D130E139, E140H169, H170K195L209, L210N225O239, O240Q259, Q260
6AA106K196N226
7AA107K197N227
8AA108K198N228
9AA109K199N229
10AA110K200N230
Sheet1


If above data is suitable then I will modified data as below and output in available next column. As per your feasibility.


Book1
ABCDEFGHIJKLMNOPQRSTUVWXYZAA
1
2PrefixAABCDEFGHIJKLMNOPQRSTUVWXYZ
3Start No101111121131141151161171181191201211221231241251261271281291301311321331341
4End No110120130140150160170180190200210220230240250260270280290300310320330340350
5
6
7
8Value for No of times generated series oncatenate1322442341231232222222222
9
Sheet3
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
Copy and unfilter in VBA
Replies
1
Views
180
Alex Blakenburg
A
T
  • Solved
Multiple columns into 2?
Replies
6
Views
263
Georgiboy
Georgiboy
M
  • Solved
run formula based on cell value to the last row
Replies
5
Views
381
MMM_84
M
C
  • Solved
VBA - Copy and paste a range of values N times
Replies
6
Views
364
cydmm
C
F
  • Question Question
VBA Code to record changes/logs modification needed?
Replies
0
Views
375
FGaxha
F

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top