Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Text to Columns and then Copy Column Data to Rows on seperate sheet...

Status
Not open for further replies.

pjmdesigns

Technical User
Mar 7, 2003
39
GB
I have a workbook with two sheets.

I intend to use sheet1 to paste a COLUMN of data into column ‘A’; this will always populate 74 rows, formatted as follows:

First Name, Paul
Last Name, John
Address 1, 5, Newton Close
Address 2, Walthamstow
...and so on

On sheet2 I have a row of headers from cell B1 to BV1. I need to copy the text (if any) after THE FIRST ',' (as there could be multiple commas per cell) from each cell starting at sheet1.A1 and copy it to the first available cell in column A on sheet2, then do the same with each cell in column A on sheet1 though to the ROW on sheet2, so sheet1.A2 populates Sheet2,B# etc.

I don’t think I have explained that very well so example as follows:

Sheet1, Column A:
First Name, Paul
Last Name, John
Address 1, 5, Newton Close
Address 2, Walthamstow

Sheet 2 populates:
Cell A3 (start of first empty row)
Paul
Cell B3
John
Cell C3
5, Newton Close
Cell D3..........to column "BV"
Walthamstow

Once saved I will return to the workbook in the future and paste a new column of data to Sheet1.column A and then by running a macro the next empty row on sheet2 will be populated with the new data, etc.

I hope this makes sense, can anyone help?

Very much appreciated.

Thanks in advance.
All the Best.
PJ
 
What have you tried so far and where in your code are you stuck ?
Tip: have a look at the InStr and Mid functions.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Apologies, I didn’t say in my request that I am not familiar with VB, I have just created a key-stroke macro on sheet1 using text to columns, but this does not account for the possibility of additional commas, beyond that I have not moved to sheet 2, I have fond scripts to make columns into rows but as yet not to put columns to the next empty row. I think I can do this with a couple of macros but it would be clunky and was really looking for something slicker.

Thanks,
PJ
 
Try the following:
Code:
Sub PopSheet2()
For i = 1 To 72
    Sheet2Count = 1 + Application.WorksheetFunction.CountA(Sheets("Sheet2").Range("A:A"))
    Sheets("Sheet2").Cells(Sheet2Count, 1) = _
        Right(Sheets("Sheet1").Cells(i, 1), _
            Application.WorksheetFunction.Max(0, Len(Sheets("Sheet1").Cells(i, 1)) - 1) - _
            InStr(Sheets("Sheet1").Cells(i, 1), ","))
Next i
End Sub
* RIGHT returns - you guessed it - the right X chars of a string
* I use MAX to prevent the macro from erroring out if you ever have an empty cell
* INSTR returns the position of a criteria within a string


[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.
 
Thanks for the response, I ran this and it returns the text after the comma per cell, excellent! Problem is though that it only does this if there is text after the comma or it falls over, as on occasion there is no text after the comma (pre-comma per cell is the question, post is the answer, which is not always complete – apologies as I don’t think I said that previously).

Also this populates Sheet2 from cell A1 down, but what I need it to do is to populate across the page, and if there is already data on row A on sheet2 then populate row B and so on.

I will have a play with your script, very useful still, as if I cannot do everyting I want in one macro I can split the data using yours and then have another on sheet2 to copy this to a row.

Would the one script to do it all be v. difficult?
Cheers,
PJ.
 
Another approach:
Use worksheet formulae to split the cells on the sheet containing the data.
Then create a macro to copy, PasteSpecial, Values, Transpose to the next empty row in the destination sheet.

In more detail:

If A1 contains: First Name, Paul
Then the formula in B1 would be: =TRIM(MID($A1,FIND(",",$A1)+1,99))
Copy the formula down to 72 rows

Then create your macro. Start the recorder,
Edit, Copy
Move to A1 in destination sheet
Ctrl-DwnArrow
Edit,PasteSpecial (select values and transpose)
Switch off the recorder


Gavin
 
If you do the above, and then simplify the recorded code, you get something like
Code:
Sub Macro2()
    Range(Sheets("data").Range("B1"), Sheets("data").Range("B1").End(xlDown)).Copy
    Sheets("Results").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=True
End Sub

Gavin
 
Cheers Gavin, almost perfect, I have everything on one sheet at the moment and it copies across nicely. I have a button at the top of the sheet to run the macro but at present it is hard coded to start at cell C3, ideally I would like either:

1) It to locate the next empty cell in column C OR
2) Uses the selected cell – I found function:
“MsgBox ActiveWindow.RangeSelection.Address”
on help but cannot figure out how to incorporate this into the macro? The line to be changed is as highlighted below.

This small hurdle and its all over.

The macro is as follows:

Sub Extract_Answers()
Range("B2,B4,B5,B9").Select
Range("B9").Activate
ActiveWindow.SmallScroll Down:=78
Range("B2,B4,B5,B9:B82").Select
Range("B9").Activate
ActiveWindow.SmallScroll Down:=-105
Selection.Copy
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
End Sub

Any ideas? Thanks again Gavin.

PJ
 
Der, Used Ctrl and down arrow as you suggested - fantastic!

Cheers Gavin!
 
Glad to have helped.
If you want to further improve it then here are some thoughts:
Your code has redundant lines (e.g. the first three lines)and can be simplified. Recorded code tends to include lots of unnecessary Selections. I think it should simplify to something like:
Code:
    Range("B2,B4,B5,B9:B82").Copy
    Range("C3").End(xlDown).Offset(1, 0).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=True
Note the above (and probably your final code)fails if there is no data in C4 as Range("C3").End(xlDown) would not give the desired result.
Solution, if it matters would be to change to:
Range("C65535").End(xlUp)

Regards,

Gavin
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top