Merge multiple rows into one

[appletree]

Help me fix my contact list! I want each person information into one row.
Sometime they have 6rows, mostly 4 like below.
Tried doing this manually, but it will take me months, please help me friends.

Problem:

John Doe

Oakhill

12345 Ny

Karl Doe

Appleroad

12345 Jersey

Karla Doe

Orangeroad

34444 Ny

Richard Doe

Hilltop

55555 Boston

<tbody>
</tbody>

How i want

John Doe, Oakhill, 12345 Ny, 11233, Customer, Yes

Karl Doe, Appleroad, 12345 Jersey, 11111,Customer, No

Karla Doe, Orangeroad,34444 Ny, 1212, Customer, Yes

Richard Doe, Hilltop ,55555 Boston, 122331, Customer,Yes

<tbody>
</tbody>

 

[gallen]

You give far too little information to be able to help.

What column is all the data in?

How is the data separated?

Do ALL contacts have the exact number of lines?

Sample data would help

 

[appletree]

You give far too little information to be able to help.

What column is all the data in?

How is the data separated?

Do ALL contacts have the exact number of lines?

Sample data would help

Thanks Gallen for the reply,i appreciate it!


I copy & pasted from my contact list to Google sheets and re-named fields as you can see.
Every black line starts new contact.
Link : https://docs.google.com/spreadsheets/d/1o3p48W5Bfv8QWc5SKQNOuOruRcpPwXtdul3W-_9FWBY/edit?usp=sharing




I want to filter contacts for example by location or name in Excel.
Please note:
1) There are 1-3 empty rows before each black line.


I hope this answers to your questions.

 

[gallen]

Sorry, I can't open links on my work's PC

If there is at least one blank line then you can work with that.

Is there any possibility of a blank line within a contact's details and not just at the end?

 

[appletree]

This is how it was on google sheets, thanks for letting me now friend! :D
I was not able to create black bar, neither i am not sure how it is made.
We could fill blanks with something, Column B is not important but would help a lot if we could take it also.

Row	Column A	Column B
1	Customer Name, Location	Information ID
2	Text, 2nd Location	Date
3	Address	Date
4
5
6
7
8	Customer Name	Information ID
9	Text	Date
10	Text	Date
11	Text
12	Location
13	Address
14
15
16
17	Customer Name	Information ID
18	Text	Date
19	Location	Date
20	Address
21
22
23	Customer Name	Information ID
24	Text	Date
25	Location
26	Address
27
28
29	Customer Name, Location	Information ID
30	Text, Location	Date
31	Text	Date
32	Text
33	Location
34	Address
35
36
37	Customer Name	Information ID
38	Text	Date
39	Text	Date
40	Text, Location
41
42
43	Customer Name	Information ID
44	Location	Date
45	Address	Date
46
47
48
49	Customer Name	Information ID
50	Text	Date
51	Location	Date
52	Address

<tbody>
</tbody>

 

[gallen]

OK, This code, is tested using the above as data and works.

This creates the information in to a worksheet named "Results" which you will have to create before running the code

Paste this in to the code window of your sheet with the data and it will work fine. You could also paste it into a module.

Sub CollateContacts()    
Dim l As Long
Dim lResults As Long 'counter for row in sheet results

Dim wsData As Worksheet 'Sheet with original data
Dim wsResults As Worksheet 'Sheet with formatted data

Dim s As String, sAppend As String

    'Set the 2 worksheets to variables for easy reference CHANGE TO YOUR SHEETS
    Set wsData = ThisWorkbook.Worksheets("Data")
    Set wsResults = ThisWorkbook.Worksheets("Results")
    
    lResults = 2 'First row to paste details
    
    With wsData
        'loop through all rows on data sheet and generate the string
        For l = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            Do Until .Range("A" & l) = ""
                If s = "" Then
                    s = .Range("A" & l)
                Else
                    s = s & ", " & .Range("A" & l)
                End If
                'As the info in column B goes at the end we stroe it in a separate string variable
                sAppend = IIf(Len(.Range("B" & l)) > 0, sAppend & ", " & .Range("B" & l), "")
                
                l = l + 1
            Loop
            'If we have a value in s then we have a row of results to write in to results
            If Len(s) > 0 Then
                wsResults.Range("A" & lResults) = s & sAppend
                lResults = lResults + 1
                s = ""
            End If
        Next
    End With
    
End Sub

 

[appletree]

I can't believe this! With pressing a button once it solved my problem just like that!

This worked perfectly, Thank you!

 

[gallen]

You're welcome. Glad it works for you.

 

[gallen]

Actually I spotted an error in the code .
I noticed that I didn't clear the sAppend variable which showed that it was being cleared by mistake in the IIF statement.
I've shown the fixes in red:

Sub CollateContacts()
Dim l As Long
Dim lResults As Long 'counter for row in sheet results


Dim wsData As Worksheet 'Sheet with original data
Dim wsResults As Worksheet 'Sheet with formatted data


Dim s As String, sAppend As String


    'Set the 2 worksheets to variables for easy reference CHANGE TO YOUR SHEETS
    Set wsData = ThisWorkbook.Worksheets("Data")
    Set wsResults = ThisWorkbook.Worksheets("Results")
    
    lResults = 2 'First row to paste details
    
    With wsData
        'loop through all rows on data sheet and generate the string
        For l = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            Do Until .Range("A" & l) = ""
                If s = "" Then
                    s = .Range("A" & l)
                Else
                    s = s & ", " & .Range("A" & l)
                End If
                'As the info in column B goes at the end we stroe it in a separate string variable
                sAppend = IIf(Len(.Range("B" & l)) > 0, sAppend & ", " & .Range("B" & l), [B][COLOR=#ff0000]sAppend[/COLOR][/B])
                
                l = l + 1
            Loop
            'If we have a value in s then we have a row of results to write in to results
            If Len(s) > 0 Then
                wsResults.Range("A" & lResults) = s & sAppend
                lResults = lResults + 1
                s = ""
               [B][COLOR=#ff0000] sAppend = ""[/COLOR][/B]
            End If
        Next
    End With
    
End Sub

I missed it because it did work for the first item in your example data. I should have made the data more real to spot it earlier. It works now. Honest