Excel vba concatenate (join cell values) based on other cell values
I need help to move the range of input and output. 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.
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