Newbie (ish) problem

  • Thread starter Thread starter et1
  • Start date Start date
E

et1

Ok - here is some of my data
Company1 Text1
Company1 Text2
Company2 Text2
company2 text2
Company2 text4
Company3 Text here
Company3 Text1
Company3 Texta

What I what to do is take that data, put it into a worksheet, an
transpose it like this
Company1 Text1,text2
Company2 Text2,Text2,text4
Company3 Text here,text1,texta

I've been trying to figure this out for a few hours.. and I can't ge
it!

Look forward to reading the answer.

Do
 
Hi Don,

Here it is

Sub MoveEm()
Dim i As Long
Dim j As Long
Dim cLastRow As Long
Dim rng As Range

Application.ScreenUpdating = False
cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To cLastRow
j = 1
Do While Cells(i + j, "A").Value = Cells(i, "A").Value
Cells(i, 2 + j).Value = Cells(i + j, "B").Value
If rng Is Nothing Then
Set rng = Cells(i + j, "A")
Else
Set rng = Union(rng, Cells(i + j, "A"))
End If
j = j + 1
Loop
i = i + j - 1
Next i
rng.EntireRow.Select
rng.EntireRow.Delete
Application.ScreenUpdating = True

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Bob

This is great, and I think I've had a bit of a Monday, cos I feel
really daft now...

I've entered the VB, but when I try and use it, I get the error 'that
name is not valid'. (I am entering =MoveEm() into the cell I want the
data to go into)

I have a worksheet called 'Source Data' that has the data like the
example show.

I am making a new worksheet called 'Top Level' that I want to move the
data to.

Apologies for being dum tonight!

Look forward to your answer!

Dom
 
Hi
you can't enter this macro name in a cell! You have to start this macro
through the menu 'Tools - Macro - Macros'
 
Ok - this works, but I made an error in the orginal spec.

I only want to see one entry, ie

Company1 Text1
Company1 Text2
Company1 Text1

to

Company1 Text1,Text2

Thanks for all the responses!

Do
 
Hi
what I was referring to was your statement: 'I am entering =MoveEm()
into the cell .....'
From this I assumed you tried to invoke the macro through entering this
line in one cell (which won't work)
 
How about this:

Option Explicit

Sub MoveEm2()
Dim iRow As Long
Dim LastRow As Long

Application.ScreenUpdating = False
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = LastRow To 2 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
'same value
.Cells(iRow - 1, "B").Value = .Cells(iRow - 1, "B").Value _
& ", " & .Cells(iRow, "B").Value
.Rows(iRow).Delete
Else
'do nothing
End If
Next iRow
End With
Application.ScreenUpdating = True

End Sub


But save your work first. It destroys the data while it's doing the work!
 
Very very Close!

The data is moved, and I get the individual company names, however,
am still getting multiple texts.

This is the actual data (well .01 %)
EURODATA Input Tax @ 17.5%
EURODATA Equipment
EURODATA Equipment
EURODATA Stationery (Subscriptions 01/02)
EURODATA Stationery (Subscriptions 01/02)
EURODATA Equipment
EURODATA Computer Services (Couriers 01/02)
EURODATA Computer Services (Couriers 01/02)
EURODATA Computer Services (Couriers 01/02)
EURODATA Computer Services (Couriers 01/02)
EURODATA Computer Services (Couriers 01/02)
EURODATA Computer Services (Couriers 01/02)
EURODATA Computer Services (Couriers 01/02)
EURODATA Computer Services (Couriers 01/02)
EURODATA Computer Services (Couriers 01/02)

And what I am trying to achieve is
EURODATA Input tax @ 17.5%, Equipment, Stationary(Subscription
01/02),Computer Services (Couriers 01/02)

Frank - Apologfies - I misunderstood you, but it was late...

Do
 
You wil all be relived to know that this does work. I just have too may
rows in my spreadsheet.

Thanks to all for your help!

Dom
 
Did you really want to repeat all those duplicated values in column B ("Computer
Services (Couriers 01/02)" shows up quite a few times under: "EURODATA".
 
Back
Top