Adding all data into 1 cell from a row ignoring blanks and adding title before whats in non blank cells

[scottyyboyy]

Hi All,

I have searched all over the net and cant find the answer.

I have a spreadsheets with hundreds of thousands of rows and hundreds of columns, I need to pull out the data that's in a row and add all into 1 cell but where it finds data in a row i need it to take the title name to the word it finds in the row.

hope this makes sense please see below

emp no.	Found data	firstname	last name	age	sex	address 1	address 2	Postcode	dob
1	dave smith 22 wheel rd b22 2bb	dave	smith			22	wheel rd	b22 2nn
2	scott 22 m 33 drive rd b22 2nn 19/02/1988	scott		22	m		33 drive rd	b22 2nn	19/02/1988
3	james bob m 22 b22 2nn 20/03/1957	james	bob		m	22		b22 2nn	20/03/1957

<tbody>
</tbody>

the green text is what i need but this is for 100,000 rows and goes to like column VZ ish.

Thanks in advance if someone can help me
Scott

 

[Fluff]

Try

Dim cl As Range
For Each cl In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1))
   cl.Value = Application.Trim(Join(Application.Index(cl.Offset(, 1).Resize(, 600).Value, 1, 0), " "))
Next cl

 

[scottyyboyy]

Try

Dim cl As Range
For Each cl In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1))
   cl.Value = Application.Trim(Join(Application.Index(cl.Offset(, 1).Resize(, 600).Value, 1, 0), " "))
Next cl

Hi,

Thanks for the reply this hasnt worked just comes up to save a macro in a module, dont know if im doing something wrong.

 

[Fluff]

Oops, forgot the start & end lines.

Sub scottyyboyy()
Dim cl As Range
For Each cl In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1))
   cl.Value = Application.Trim(Join(Application.Index(cl.Offset(, 1).Resize(, 600).Value, 1, 0), " "))
Next cl
End Sub

 

[scottyyboyy]

Oops, forgot the start & end lines.

Sub scottyyboyy()
Dim cl As Range
For Each cl In Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1))
   cl.Value = Application.Trim(Join(Application.Index(cl.Offset(, 1).Resize(, 600).Value, 1, 0), " "))
Next cl
End Sub

Hi Bud,

That is pulling the data from the row but i need it to take the title from row 1 where it finds data and add the title name before the data if finds.

hope this makes sense.

Regards

 

[scottyyboyy]

Hi All,

I have searched all over the net and cant find the answer.

I have a spreadsheets with hundreds of thousands of rows and hundreds of columns, I need to pull out the data that's in a row and add all into 1 cell but where it finds data in a row i need it to take the title name to the word it finds in the row.

hope this makes sense please see below

emp no.	Found data	firstname	last name	age	sex	address 1	address 2	Postcode	dob
1	first name dave last name smith adress 1 22 address 2 wheel rd postcode b22 2bb	dave	smith			22	wheel rd	b22 2nn
2	first name scott age 22 sex m address 233 drive rd postcode b22 2nn dob 19/02/1988	scott		22	m		33 drive rd	b22 2nn	19/02/1988
3	first name james surname bob sex m address 1 22 postcode b22 2nn dob 20/03/1957	james	bob		m	22		b22 2nn	20/03/1957

<tbody>
</tbody>

the green text is what i need but this is for 100,000 rows and goes to like column VZ ish.

Thanks in advance if someone can help me
Scott

sorry i wrote the table incorrect please see updated my apologies

 

[Fluff]

If your data goes over to column VZ then you are likely going to hit problems with the length of string.

 

[scottyyboyy]

Hi Fluff,

sorry i have now done an updated quote

thank you for your time

 

[Fluff]

Try

Sub scottyyboyy()
   Dim Ary As Variant
   Dim r As Long, c As Long
   Dim Tmp As String
   
   Ary = ActiveSheet.UsedRange.Value2
   For r = 2 To UBound(Ary)
      For c = 2 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            If Tmp = "" Then Tmp = Ary(1, c) & " " & Ary(r, c) Else Tmp = Tmp & " " & Ary(1, c) & " " & Ary(r, c)
         End If
      Next c
      Debug.Print Len(Tmp)
      Ary(r, 1) = Tmp
      Tmp = ""
   Next r
   Range("A1").Resize(UBound(Ary), UBound(Ary, 2)).Value = Ary
End Sub

But with 100,000 rows & 600 columns, it may well fail.

 

[scottyyboyy]

Hi Fluff,

That has worked great thank you.

Regards