Can any help with a little script

  • Thread starter Danny Boy via OfficeKB.com
  • Start date
D

Danny Boy via OfficeKB.com

I have managed to produce my first macro

The only problem is the layout, I wonder if any one has a script for the
following

BATMAN CAPER WINGS
BATMAN LEATHER CAROL SONGERS
BATMAN SPONGE BATS SCARE ME
ROBIN PUFF THE
ROBIN MAGIX DRAGON
ROBIN LIVES IN THE BRONX

Above is the original layout (not the content, I made that up :))

I want a macro to output it like:

Batman CAPER LEATHER SPONGE WINGS
CAROL SINGERS BATS SCARE ME
Robin PUFF THE MAGIX
DRAGON LIVES IN THE BRONX

I know that this can be done in a pivot table, but thats not the way I want
to do it!!!

Anyone help me pleeeassse
 
C

Crowbar via OfficeKB.com

Batman CAPER LEATHER SPONGE WINGS
CAROL SINGERS BATS SCARE ME
Robin PUFF THE MAGIX
DRAGON LIVES IN THE BRONX


I was miss led with these input boxes,

Carol Singers and Bats Scare Me should be on the same line

DAMM YOU INPUT BOX
 
D

Dave Peterson

You changed patterns--once you went down column B, then to column C (for
batman).

But for robin, you went across per row.

This goes across row by row:

Option Explicit
Sub testme01()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long

Dim RngToCopy As Range
Dim DestCell As Range
Dim iRow As Long
Dim oRow As Long

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

With curWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

oRow = 0
For iRow = FirstRow To LastRow
If .Cells(iRow, 1).Value = .Cells(iRow - 1, 1).Value Then
'same key, apend to the far right
Set RngToCopy = .Range(.Cells(iRow, 2), _
.Cells(iRow, .Columns.Count).End(xlToLeft))
With newWks
Set DestCell = .Cells(oRow, .Columns.Count) _
.End(xlToLeft).Offset(0, 1)
End With
Else
oRow = oRow + 1
Set RngToCopy = .Rows(iRow)
Set DestCell = newWks.Cells(oRow, 1)
End If

RngToCopy.Copy _
Destination:=DestCell
Next iRow
End With

newWks.UsedRange.Columns.AutoFit

End Sub

Add headers to the first sheet if you don't have them already.
 
D

Danny Boy via OfficeKB.com

Hi Dave

Thanks for your response,

I'm sure that there is nothing wrong with your script but it won't work on my
workbook. Please ignore my first 2 posts. I have now changed my mined and
want to do it from the format below

I have 2 Columns will this style info:

Batman CAPER
Batman CLOWN
Batman FAIRY

I would like a macro to output:

Batman CAPER CLOWN FAIRY

Please note that all the data will be different but the columns will remain
the same with all the reports that need this alteration.
 
D

Dave Peterson

The existing macro worked fine for me with your both samples of your data.

What happens when you try it?

Make sure you point at the correct sheet (I used Sheet1):
Set curWks = Worksheets("sheet1")

and remember to: Add headers to the first sheet if you don't have them already.
 
B

Bob Phillips

See response to your other thread

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)
 
D

Danny Boy via OfficeKB.com

Thanks Dave and Bob

Dave, I was getting an error at destcell, I put a on error resume next
command in, inserted a blank row on my data sheet as the program started at
row 2 (I did try to change that to row 1 but it outputted the data wrong)

Once again thanks for all your help
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top