Summarising data

[englishtwit]

I think this is difficult!

My source data is made up of two worksheets from two different dat
sources.
Worksheet1 looks like
A B
1.ICT SUBSISTENCE
2.ICT TELEPHONES & FAX
3.ICT TRAINING EXPENSES
4.ICT WORKSHOP MATERIAL & TOOLS
5 0-12 NORTHAMPTON TEAMM APT&C BASIC
6 0-12 NORTHAMPTON TEAMM CATERING
7 0-12 NORTHAMPTON TEAMM CLEANING & DOMESTIC EQUIPMENT
8 0-12 NORTHAMPTON TEAMM EQUIPMENT PURCHASE
9 0-12 NORTHAMPTON TEAMM ESSENTIAL PAYMENTS
10 0-12 NORTHAMPTON TEAMM FABRIC/WINDOW/DOOR (NON STRAT)

Worksheet 2 is just a unique list of the names as described in Column
above i.e.
.ICT
0-12 NORTHAMPTON etc
I need to produce a third worksheet that just has
A B
.ICT Subsistence,telephone
and fax etc
0-12 Northampton Teamm APT&C, Catering etc

Column B can either all merge into one cell or into individual cells.

So, to summarise.
I want to take all the unique values of column A from worksheet 2, an
combine them with the values of column B in worksheet 1 into a thir
worksheet. The third worksheet will only show a unique name (i.e. .ICT
and the all the values of column B of worksheet 1 next to it.

Thanks!
E

 

[hcj]

Hi ET,
I have a rather wordy solution for this, similar to
that for a previous post trying to reassemble address
fragments. I'm NOT a VB programmer, so my solution
involves a bit of data prep and formula construction in
the first row, but it does work. If you have more than a
few dozen records and/or this is a recurring need, the fix
is worth the trouble on the first go-round.
I'll wait a day or so to see if someone else comes up
with a neat fix; then, if not, I'll post my solution.
I'll be more than happy to yield to an elegant solution!
Meanwhile, I'm going to work out a clear write-up and
package it for future use; I've seen this problem too many
times.
If you're a VB programmer, then you're way ahead of
me. Otherwise, if you like, post back with an ESTIMATE of
how many unique instances of col A you have and how many
records for each of those, especially an estimate of the
max number of those you'd ever expect to see.

Standing by, hcj

 

[Dave Peterson]

Run this against a copy of your workbook--or close without saving if it's wrong!

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim UniWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim res As Variant

Set curWks = Worksheets("sheet1")
Set UniWks = Worksheets("sheet2")

With curWks
'sort by column A with no header!
.Range("a:b").Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlNo, _
MatchCase:=False, Orientation:=xlTopToBottom

FirstRow = 1 'no header row!
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow + 1 Step -1
res = Application.Match(.Cells(iRow, "A").Value, _
UniWks.Range("a:a"), 0)
If IsError(res) Then
'delete the row
.Rows(iRow).Delete
Else
If .Cells(iRow - 1, "A").Value = .Cells(iRow, "A").Value Then
.Cells(iRow - 1, "B").Value _
= .Cells(iRow - 1, "B").Value & vbLf _
& .Cells(iRow, "B").Value
.Rows(iRow).Delete
End If
End If
Next iRow
End With

End Sub