Excel Problem 2

[frankcpl]

I am working on an excel worksheet that I need some help on. I will try to explain it the best I know how. The worksheet has column a for assignment(apartment), which could have 2 to 6 occupients. Column b is the last name of said occupients. Column c is first name of said occupients and column d is roomates of said occupients. What I am wanting to do is combine the roomates name in column d, e, f, ect until end of like apartments. If column a has 2 apartment numbers that match, then column d would show the names merged in the same cell.
Assingment Last Name First Name Roomate1 Roomate2
BEN A11 Bonner Kathryn
BEN A11 Roberts April
BEN A13 Ferguson Morgan
BEN A13 Williams Jessica
BEN A14 Coghlan Tara
BEN A14 Hill Brittany
BEN A14 Reeder Jessica
BEN A14 Salinas Beatrice
BEN A14 Saxton Shelby

The end result for BEN A11 would be:
BEN A11 Bonner Kathryn Bonner, Roberts,
ANy help would be greatly appreciated.

 

[zelgar]

for your example above, a macro looking like the following:

sub roommate()
dim roommate
roommate=1
start = 1
end = 9
for x = start to end
for y = start to end
if x <>y then
if range("a"+trim(str(x)))=range("a"+trim(str)) then
range("d"+trim(str(x)))= range("b"+trim(str(x)))
range(chr$(68+roommate)+trim(str(x)))=range("b"+trim(str))
rows.delete ' omit if you don't want to delete roommate listing
y = y - 1 ' omit if you don't want to delete roommate listing
end = end - 1 ' omit if you don't want to delete roommate listing
roommate=roommate+1
end if
end if
next y
roommate = 1
next x
end sub

 

[Gruuuu]

this is much easier handled by a SQL query.
frank, are you familiar with SQL?

 

[zelgar]

I noticed a slight error in my macro. It cannoot be named the same as a variable, so the name needs to be changed from "roommate" to something else.

 

[frankcpl]

Thanks for the help. I am not having any luck getting it to do what I am wanting. I am not fimiliar with SQL either. I don't know how else I can explain it to provide the information of what I am needing. The excel document I am working on size changes depending on people. I tried useing the above example and it didn't respond and froze excel.

 

[SkipVought]

hi,

Your posted example is not clear because you have not used proper TGML tagging to format each column of data properly.

Your example is also not consistent with your expected result...
[tt]
BEN A11 Bonner Kathryn
BEN A11 Roberts April
[/tt]
[tt]
BEN A11 Bonner Kathryn Bonner, Roberts,
[/tt]
Please explain how you get from one to the other.

Also, what is the difference between an occupant and a roommate?
Do roommates not have first and last names?
Where do the commas come from or not?
Where is April?

It is not at all clear and consistent!


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[zelgar]

Change "end" to something else (e.g., "endx") and it works fine.
Output looks like this:
Assingment Last Name  First Name Roomate1 Roomate2
BEN A11 Bonner       Kathryn     Bonner       Roberts     
BEN A13 Ferguson     Morgan     Ferguson     Williams    
BEN A14 Coghlan      Tara     Coghlan      Hill         Reeder       Salinas      Saxton      

 

[zelgar]

Change the "end" on the following lines
end = 9
for x = start to end
for y = start to end
end = end-1


Sorry for any confusion

 

[SkipVought]

Shouldn't the output look something like this...
[tt]
Assignment Roommate1 Roommate2 Roommate3 Roommate4 Roommate5
BEN A11 Bonner, Kathryn Roberts, April
BEN A13 Ferguson, Morgan Williams, Jessica
BEN A14 Coghlan, Tara Hill, Brittany Reeder, Jessica Salinas, Beatrice Saxton, Shelby
[/tt]


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[frankcpl]

I am sorry for the confusion on what I am wanting. I have the data in columns of.
Assignment Last Name First Name Roommate Name Phone #
Ben A11 Bonner Kathryn
Ben A11 Roberts April
ect...

I would like the results to be
Assignment Last Name First Name Roommate Name Phone # Roommate-->
Ben A11 Bonner Kathryn Bonner, Kathryn # Roberts, April #

I am double checking spelling on the above script. When I put in end = 1, I get a complie error? Looking into that

 

[frankcpl]

Skip you have the end results of what I am looking for, I just haven't figured out how to get that. Once I get the basic, I can add the other fields that are required such as phone number and such. Just don't have room to give it a clean layout so it looks right.

 

[papadba]

Just don't have room to give it a clean layout so it looks right.

Assignment Roommate1        Roommate2         Roommate3       Roommate4         Roommate5
BEN A11    Bonner, Kathryn  Roberts, April            
BEN A13    Ferguson, Morgan Williams, Jessica            
BEN A14    Coghlan, Tara    Hill, Brittany    Reeder, Jessica Salinas, Beatrice Saxton, Shelby

To get this "layout" use the Code tag. To learn about tags click on the "here" (Click Here for the full list of TGML tags) in EDITING TIPS.

 

[SkipVought]

This is the code that produces the above posted results

Sub Summarize()
'assumptions:
' the assignment table begins in A1
' there is an empty sheet after the assignment sheet
' the assignment sheet is the acitve sheet when this procedure begins
' the assignment table has only headings related to assignment (no roommate headings)

    Dim wsTHIS As Worksheet, wsSUM As Worksheet, r As Range
    Dim lRow As Long, iCol As Integer, iMaxCol As Integer, sPrev As String, c As Integer, colLIM As Integer
    
    Set wsTHIS = ActiveSheet
    Set wsSUM = Sheets(wsTHIS.Index + 1)
    
    wsSUM.Cells.Clear
    colLIM = wsTHIS.UsedRange.Columns.Count
    
    'summarize
    lRow = 1
    For Each r In Range([A2], [A2].End(xlDown))
        If sPrev <> r.Value Then
            GoSub NextRow
        End If
        iCol = iCol + 1
        With wsSUM.Cells(lRow, iCol)
            For c = 2 To colLIM
                .Value = .Value & r.Offset(0, c - 1) & ", "
            Next
            .Value = Left(.Value, Len(.Value) - 1)
        End With
    Next
    
    'summarize headings
    wsSUM.Cells(1, 1).Value = "Assignment"
    If iMaxCol < iCol Then iMaxCol = iCol
    For iCol = 2 To iMaxCol
        wsSUM.Cells(1, iCol).Value = "Roommate" & iCol - 1
    Next
    
    Exit Sub
NextRow:
    lRow = lRow + 1
    If iMaxCol < iCol Then iMaxCol = iCol
    iCol = 1
    sPrev = r.Value
    wsSUM.Cells(lRow, iCol).Value = sPrev
    Return
End Sub

It will work if you add data to your table like this...
[tt]
Assingment Last Name First Name Phone
BEN A11 Bonner Kathryn 999-999-9999
BEN A11 Roberts April 999-999-9999
BEN A13 Ferguson Morgan 999-999-9999
BEN A13 Williams Jessica 999-999-9999
BEN A14 Coghlan Tara 999-999-9999
BEN A14 Hill Brittany 999-999-9999
BEN A14 Reeder Jessica 999-999-9999
BEN A14 Salinas Beatrice 999-999-9999
BEN A14 Saxton Shelby 999-999-9999
[/tt]


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[zelgar]

just a few minor tweaks to my macro...

Sub rm()
'
' roommate Macro
'
Dim roommate
roommate = 1
Start = 2
endx = 10
For x = Start To endx
For y = Start To endx
If x <> y Then
If Range("a" + Trim(Str(x))) = Range("a" + Trim(Str)) Then
Range(Chr$(67 + roommate) + Trim(Str(x))) = Range("b" + Trim(Str)) + ", " + Range("c" + Trim(Str))
Rows.Delete
y = y - 1
endx = endx - 1
roommate = roommate + 1
End If
End If
Next y
roommate = 1
Next x
'
End Sub

 

[zelgar]

now if you also want it to automatically do your headers & resize your columns...

Sub rm()
'
' roommate Macro
'
Dim roommate, matetotal
roommate = 1
Start = 2
endx = 10
matetotal = 0
For x = Start To endx
    For y = Start To endx
    If x <> y Then
        If Range("a" + Trim(Str(x))) = Range("a" + Trim(Str(y))) Then
            Range(Chr$(67 + roommate) + Trim(Str(x))) = Range("b" + Trim(Str(y))) + ", " + Range("c" + Trim(Str(y)))
            Rows(y).Delete
            y = y - 1
            endx = endx - 1
            If matetotal < roommate Then matetotal = roommate
            roommate = roommate + 1
        End If
    End If
    Next y
roommate = 1
Next x
For Z = 1 To matetotal
    Range(Chr$(67 + Z) + "1") = "Roommate #" + Trim(Str(Z))
Next Z
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select '
End Sub

p.s. sorry about not having the code in the proper format in previous posts

 

[frankcpl]

I really appreciate the help on this. Both of the codes helped me out. Now I have a starting point so I can tweak the code if the need arises.

 

[frankcpl]

What am I messing up on this part of the code.

Assignment LName FName Phone
BenA11 Doe Jane 9999999999
BenA11 Jane Doe 9999999999

I get a type mismatch error at this part of the code:

Range(Chr$(67 + roommate) + Trim(Str(x))) = Range("b" + Trim(Str)) + ", " + Range("c" + Trim(Str)) + " Phone: " + Range("d" + Trim(Str))

I can change column d to anything but numbers and it work fine. Any help?

 

[SkipVought]

Hit the DEBUG button and examine the values of your variables using faq707-4594.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

BTW, I can run your code as posted, wthout error, using the first posted table example as source data.

However, I do not recommend destroying the source data, which is why my code assembles the results in a different sheet.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[frankcpl]

Skip thank you for quick reply. The reason I am not worried about the data is this sheet is being popluated by the control sheet that keeps the data safe. As for your code, it confuses me because I don't understand it. I like the way it works, but if I needed to change something, I wouldn't even know where to begin. I want to learn the code not just have people write it for me.

Again thanks a ton for the quick reply.