Automatic Serial Number before Text in a Cell

[arijitirf]

Hi!
In Column D, data of Column F:O flows through Text Join skipping Blank cell. I want a formula that generates auto incremental serial number (1, 2, 3, 4 and so on).

Let's assume,

Data in Column
F as "Rameshwaram"
G as "Somenath"
H as "Kedarnath"
I as " "
J as "Baidyanath"
K as " "
L as " "
M as "Kashi Viswanath"
N as "Trimbakeshwar"
O as "Mahakaleshwar"

Then data in Column D will be
1. '"Rameshwaram"'
2. "Somenath"
3. "Kedarnath"
4. "Baidyanath"
5. "Kashi Viswanath"
6. "Trimbakeshwar"
7. "Mahakaleshwar"

Is there any way to do that. I have come across a excellent formula in this forum which can do the same for Row however, the same is not useful for me.

Thanks in advance

 

[arijitirf]

You mean everything in cell D1? like this?

Book1
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1			1. Rameshwaram 2. Somenath 3. Kedarnath 4. Baidyanath 5. Kashi Viswanath 6. Trimbakeshwar 7. Mahakaleshwar		Rameshwaram	Somenath	Kedarnath		Baidyanath			Kashi Viswanath	Trimbakeshwar	Mahakaleshwar
2
3
4
Sheet2

Yes with Char(10) in between

 

[Joe4]

A formula approach is probably beyond my abilities, but here is a VBA approach that will produce what the image Cubist shows (in column D):

Sub PopulateColumn()

    Dim rng As Range
    Dim cell As Range
    Dim ct As Long
   
    Application.ScreenUpdating = False
   
'   Set range to loop through
    Set rng = Range("F1:O1")
   
'   Loop through all cells in rng
    For Each cell In rng
'       Check to see if it is a non-blank value
        If cell.Value <> "" Then
'           Add one to counter
            ct = ct + 1
'           Populate column D
            Cells(ct, "D").Value = ct & ". " & cell.Value
        End If
    Next cell
   
    Application.ScreenUpdating = True

End Sub

Result:

 

[Cubist]

@Joe4

With further clarification, the OP wants a concatenated string in one singular cell D1, separated by CHAR(10).

 

[arijitirf]

A formula approach is probably beyond my abilities, but here is a VBA approach that will produce what the image Cubist shows (in column D):

Sub PopulateColumn()

    Dim rng As Range
    Dim cell As Range
    Dim ct As Long
  
    Application.ScreenUpdating = False
  
'   Set range to loop through
    Set rng = Range("F1:O1")
  
'   Loop through all cells in rng
    For Each cell In rng
'       Check to see if it is a non-blank value
        If cell.Value <> "" Then
'           Add one to counter
            ct = ct + 1
'           Populate column D
            Cells(ct, "D").Value = ct & ". " & cell.Value
        End If
    Next cell
  
    Application.ScreenUpdating = True

End Sub

Result:
View attachment 109484

Thank you for your valuable code. Only change is the data of Column F1:O1 will flow in D1 and will continue to flow in the same row in Column D:D. It was my mistake that I forgot to mention the same in my first thread.

 

[Joe4]

@Joe4

With further clarification, the OP wants a concatenated string in one singular cell D1, separated by CHAR(10).

Precisely why pictures are so much better at explaining these things to show exactly what the desired result is!

I think this variation should do the trick:

Sub PopulateColumn()

    Dim rng As Range
    Dim cell As Range
    Dim ct As Long
    Dim str As String
  
    Application.ScreenUpdating = False
  
'   Set range to loop through
    Set rng = Range("F1:O1")
  
'   Loop through all cells in rng
    For Each cell In rng
'       Check to see if it is a non-blank value
        If cell.Value <> "" Then
'           Add one to counter
            ct = ct + 1
'           Build on to string
            str = str & ct & ". " & cell.Value & Chr(10)
        End If
    Next cell
  
'   Put result in cell D1
    Range("D1") = Left(str, Len(str) - 1)
  
    Application.ScreenUpdating = True

End Sub

Result:

 

[arijitirf]

Thank you both @Joe4
and @Cubist
for your help. Since I do not have my Laptop with me, I can not check it. I shall definitely let you know tomorrow. Thank you once again.

 

[arijitirf]

Precisely why pictures are so much better at explaining these things to show exactly what the desired result is!

I think this variation should do the trick:

Sub PopulateColumn()

    Dim rng As Range
    Dim cell As Range
    Dim ct As Long
    Dim str As String
 
    Application.ScreenUpdating = False
 
'   Set range to loop through
    Set rng = Range("F1:O1")
 
'   Loop through all cells in rng
    For Each cell In rng
'       Check to see if it is a non-blank value
        If cell.Value <> "" Then
'           Add one to counter
            ct = ct + 1
'           Build on to string
            str = str & ct & ". " & cell.Value & Chr(10)
        End If
    Next cell
 
'   Put result in cell D1
    Range("D1") = Left(str, Len(str) - 1)
 
    Application.ScreenUpdating = True

End Sub

Result:
View attachment 109485

Good morning from India.

Your code is perfectly working for Range F1:O1 and data from Range F1:O1 is perfectly flowing in D1.

I want the same result for each Row in Column D till D503. Like D2 will show the result from F2:O2 and so on till Range F503:O503.

Kindly check if you could help me with that. Thank you once again for spending your valuable time for me.

 

[Cubist]

Maybe this. The code assumes the activesheet.

Sub PopulateColumn()
    Dim rng As Range
    Dim dataArr As Variant
    Dim outputArr() As String
    Dim i As Long, j As Long
    Dim ct As Long
  
    Application.ScreenUpdating = False
  
    Set rng = Range("F1:O3")
  
    dataArr = rng.Value
  
    ReDim outputArr(1 To UBound(dataArr, 1))
  
    For i = 1 To UBound(dataArr, 1)
        ct = 0
        outputArr(i) = ""
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                ct = ct + 1
                outputArr(i) = outputArr(i) & ct & ". " & dataArr(i, j) & Chr(10)
            End If
        Next j
        outputArr(i) = Left(outputArr(i), Len(outputArr(i)) - 1)
    Next i
  
    Range("D1").Resize(UBound(outputArr), 1).Value = Application.Transpose(outputArr)
  
    Application.ScreenUpdating = True
End Sub

 

[arijitirf]

Sub PopulateColumn() Dim rng As Range Dim dataArr As Variant Dim outputArr() As String Dim i As Long, j As Long Dim ct As Long Application.ScreenUpdating = False Set rng = Range("F1:O3") dataArr = rng.Value ReDim outputArr(1 To UBound(dataArr, 1)) For i = 1 To UBound(dataArr, 1) ct = 0 outputArr(i) = "" For j = 1 To UBound(dataArr, 2) If Not IsEmpty(dataArr(i, j)) Then ct = ct + 1 outputArr(i) = outputArr(i) & ct & ". " & dataArr(i, j) & Chr(10) End If Next j outputArr(i) = Left(outputArr(i), Len(outputArr(i)) - 1) Next i Range("D1").Resize(UBound(outputArr), 1).Value = Application.Transpose(outputArr) Application.ScreenUpdating = True End Sub

Run-time error 5
Invalid Procedure call or argument

By the way the Range shall be F1:O503 and the date will flow in D1:D503

 

[Cubist]

I only had 3 rows of data to test. Forgot to change back. Which line gave you the error? Maybe try this. Change the sheet name to your sheet name

Sub PopulateColumn()
    Dim ws As Worksheet
    Dim rng As Range
    Dim dataArr As Variant
    Dim outputArr() As String
    Dim i As Long, j As Long
    Dim ct As Long
 
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'Change sheet name as needed.
    Set rng = ws.Range("F1:O503")
 
    dataArr = rng.Value
 
    ReDim outputArr(1 To UBound(dataArr, 1))
 
    For i = 1 To UBound(dataArr, 1)
        ct = 0
        outputArr(i) = ""
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                ct = ct + 1
                outputArr(i) = outputArr(i) & ct & ". " & dataArr(i, j) & Chr(10)
            End If
        Next j
        outputArr(i) = Left(outputArr(i), Len(outputArr(i)) - 1)
    Next i
 
    ws.Range("D1").Resize(UBound(outputArr), 1).Value = Application.Transpose(outputArr)
 
    Application.ScreenUpdating = True
End Sub