About Us

Willc

Awesome . . . thanks for all the help!

"JLatham" wrote:

If things are laid out as you've shown, this will work for you. There are
some Const definitions at the beginning of the code, just change those to
coincide with how things are really laid out on the sheet and it will work.
If you have more columns to copy on down the sheet, you can get an idea of
how to add constants and variables to deal with those from this code, or
contact me at [remove spaces] HelpFrom @ jlathamsite.com

One limit is that there can't be any empty cells in the primary column,
which I set up as A in this code:

Sub ExtendAndTranspose()
Const theWorksheet = "Sheet1" ' change as needed
Const firstColToCopy = "A" ' change as needed
Const secondColToCopy = "B" ' change as needed
Const columnToTranspose = "C" ' change as needed
Const firstRowWithData = 2 ' change as needed

Dim storeName As String
Dim storeType As String
Dim oneGroup As String ' to be transposed
Dim rOffset As Long ' pointer
Dim cOffset As Integer ' to transpose column
Dim rowToDelete As Long
Dim TLC As Integer ' transpose loop counter

'this assumes all rows used until no data;
' that is, no blank entries in column A until
' we are out of entries to work with
'
'make sure we are where we should be
Worksheets(theWorksheet).Select
'this is the "primary" column: A in this case
Range(firstColToCopy & firstRowWithData).Select
'calculate offset from base column (A) to the
'column with data to transpose (C)
cOffset = Range(columnToTranspose & "1").Column - _
Range(firstColToCopy & "1").Column
'turn of screen updating to improve performance
Application.ScreenUpdating = False
'begin the work
Do While Not IsEmpty(ActiveCell.Offset(rOffset, 0))
oneGroup = Trim(ActiveCell.Offset(rOffset, cOffset))
If Len(oneGroup) 0 Then
'have some stuff to transpose
'get store name and type to fill on down
'as rows are inserted
rowToDelete = firstRowWithData + rOffset
storeName = Range(firstColToCopy & firstRowWithData). _
Offset(rOffset, 0)
storeType = Range(secondColToCopy & firstRowWithData). _
Offset(rOffset, 0)
For TLC = 1 To Len(oneGroup)
'only adds new row when there is a letter
'in "oneGroup" - skips commas, spaces, etc.
If UCase(Mid(oneGroup, TLC, 1)) = "A" And _
UCase(Mid(oneGroup, TLC, 1)) <= "Z" Then
rOffset = rOffset + 1
ActiveCell.Offset(rOffset, 0).EntireRow.Insert
Range(firstColToCopy & firstRowWithData). _
Offset(rOffset, 0) = storeName
Range(secondColToCopy & firstRowWithData). _
Offset(rOffset, 0) = storeType
ActiveCell.Offset(rOffset, cOffset) = _
Mid(oneGroup, TLC, 1)
End If
Next ' TLC
Range(firstColToCopy & rowToDelete).EntireRow.Delete
rOffset = rOffset - 1 'adjust for deleted row
End If ' test of oneGroup length
rOffset = rOffset + 1 ' to next possible row
Loop ' empty cell test loop
Application.ScreenUpdating = True ' back on now
End Sub

"willc" wrote:

Thanks for the reply . . . and VBA would be great. The more automated the
better. There will be several hundred rows. Thanks again for the help.

"willc" wrote:

Folks,

I have a multi-column excel spreadsheet where one column has a text string
that I need to explode into individual rows while keeping the adjacent column
data. I doubt I'm using the correct nomenclature so I'm putting an example
of what I'm attempting below.

Thanks for any help on this.

A B C A
B c
store a typea a,b,c,d what I want is: store a typea a
store b typeb e,f,g,h store a typea
b
store a
typea c
store a
typea d
store b
typeb e
etc . . .

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
When data match, copy adjacent value to adjacent column	slimbim	Excel Worksheet Functions	2	November 8th 06 08:41 PM
Convert column data to semicolon delimited text string	Richard RE	Excel Worksheet Functions	1	September 5th 06 03:03 PM
Macro to find text string in a column and paste data in another	nicolascap	Excel Discussion (Misc queries)	8	March 14th 06 03:13 PM
Finding a string/using adjacent data question	[email protected]	Excel Discussion (Misc queries)	4	January 9th 06 03:59 PM
copying data to an adjacent cell	Paul K.	Excel Discussion (Misc queries)	2	October 5th 05 03:39 PM

Menu

About Us