cd_morris
asked on
Combine records
I am looking for a way to combine like records an put the resoults in one cell. Please see attached file!
Thanks in advanced!
Thanks in advanced!
Hello cd_morris,
I'm confused. On what basis should the entries associated with 12R096-3 be separated as per your example?
Regards,
Patrick
I'm confused. On what basis should the entries associated with 12R096-3 be separated as per your example?
Regards,
Patrick
ASKER
If there is only entry the one if then only once as is. If multiple for a location then a in the exemple
1. Make a pivot table. (Refer the attachment)
2. Copy-Paste the pivot table.
3. Concatenate. (Refer the attachment)
Hope this helps.
Tils
Copy-of-TestData.xls
2. Copy-Paste the pivot table.
3. Concatenate. (Refer the attachment)
Hope this helps.
Tils
Copy-of-TestData.xls
ASKER
If only one entry fora data point (12R096-3) then there no nothing to do.
cd_morris,
Sorry, still not making sense. In your example, Col B has only 2 distinct values, yet your sample output shows
three groups. Why?
FWIW, I am liking tilsant's PT idea...
Patrick
Sorry, still not making sense. In your example, Col B has only 2 distinct values, yet your sample output shows
three groups. Why?
FWIW, I am liking tilsant's PT idea...
Patrick
i jus realised tht i've made some mistake.
this one is fine i guess..
Copy-of-TestData.xls
Copy-of-TestData.xls
In my first attachment, i had put "Count of tmp1" in the "Data" field which i changed to "Sum of tmp2"........ which i hope is what cd_morris wants.
ASKER
Good catch Patrick my mistake. They should
be in the same cell.
be in the same cell.
ASKER
Tilsant, I undrstand the Pivoit table and the concatenation but items 1, item 2 and item 3 needs to be in the same cell
ASKER
Example C11 would look like this:
Item 1 - 2
Item 2 - 2
Item 3 - 1
Item 1 - 2
Item 2 - 2
Item 3 - 1
u intend to "merge" the cells??
Sub ReBorder(r2 As Range)
With r2
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.BorderAround xlContinuous, xlMedium
End With
With r2.Offset(, 1)
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.BorderAround xlContinuous, xlMedium
End With
End Sub
Sub combineme()
Application.ScreenUpdating = False
Dim r As Range, r2 As Range, r3 As Range, r4 As Range, oldVal As String
Set r3 = Sheets("Sheet1").Range("B11") '' << SET TARGET HERE (top left)
Set r4 = Sheets("Sheet1").Range("B2:B7") '' << SET SOURCE HERE
Set r = r4.Cells(1)
oldVal = ""
While r.Row < r4.Row + r4.Rows.Count
Set r2 = r
While r2.Offset(1).Value = r2.Value And r2.Offset(1, 1).Value = r2.Offset(, 1).Value
Set r2 = r2.Offset(1)
Wend
If r.Value = oldVal Then
r3.Value = ""
Else
r3.Value = r.Value
If oldVal > "" Then ReBorder Range(r3.Offset(-1), r3.Offset(-1).End(xlUp))
oldVal = r.Value
End If
r3.Offset(, 1).Value = r.Offset(, 1).Value & " - " & Application.WorksheetFunction.Sum(Range(r, r2).Offset(, 2))
Set r = r2.Offset(1)
Set r3 = r3.Offset(1)
Wend
If oldVal > "" Then ReBorder Range(r3.Offset(-1), r3.Offset(-1).End(xlUp))
Application.ScreenUpdating = True
End Sub
If u intend to merge the cells, then u can copy the table that we created (using the PT and then the concatenation stuff). U can paste this table on some other sheet (cell A1) and run the attached code.
Sub tmp()
For i = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If Range("A" & i) = "" Then
Range("B" & i - 1) = Range("B" & i - 1) & vbLf & Range("B" & i)
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
Copy-of-TestData.xls
Macro to merge from source to target
Sub combineme()
Application.ScreenUpdating = False
Sheets(1).Range("B11:C15").ClearContents
Dim r As Range, r2 As Range, r3 As Range, r4 As Range, s As String
Set r3 = Sheets("Sheet1").Range("B11") '' << SET TARGET HERE (top left)
Set r4 = Sheets("Sheet1").Range("B2:B7") '' << SET SOURCE HERE
Set r = r4.Cells(1)
While r.Row < r4.Row + r4.Rows.Count
s = ""
Set r2 = r
While r2.Offset(1).Value = r2.Value
While r2.Offset(1).Value = r2.Value And r2.Offset(1, 1).Value = r2.Offset(, 1).Value
Set r2 = r2.Offset(1)
Wend
s = s & r2.Offset(, 1).Value & " - " & Application.WorksheetFunction.Sum(Range(r, r2).Offset(, 2)) & Chr(10)
Set r2 = r2.Offset(1)
Set r = r2
Wend
s = s & r2.Offset(, 1).Value & " - " & Application.WorksheetFunction.Sum(Range(r, r2).Offset(, 2)) & Chr(10)
Set r = r2.Offset(1)
r3.Value = r.Offset(-1).Value
r3.Offset(, 1).Value = Left(s, Len(s) - 1)
Set r3 = r3.Offset(1)
Wend
Application.ScreenUpdating = True
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
TestData.xls