A hard one...rearanging data

gentrric

New Member
I'm tring to rearange data for import into Access. All related data is in the same row and I need to transpose some of the cells within this row into columns. There are over 1000 rows. Is there a simple way to do this other than copy and paste?
Book1
ABCDEFGHIJ
1ThedatathatIneedtorearangelookslikethis.Thereareover1000rows.
2
3Course#ClassnameInstructorParticipantParticipantParticipantParticipantParticipantParticipant
4WQ3005MSWordSmithJudySamHenryLarryDiane
5WQ2145MSAccessSamHenrySimonPeterNancy
6WQ3211DataentryJohnPeterPatti
7
8Ineedtotransposetheparticipantsineachclassfromrowstocolumns,butleaveeverythingelseinrowslikethis.
9
10Course#ClassnameInstructorParticipant
11WQ3005MSWordSmithJudy
12Sam
13Henry
14Larry
15Diane
16WQ2145MSAccessSamHenry
17Simon
18Peter
19Nancy
20WQ3211DataentryJohnPeter
21Patti
Sheet1

This message was edited by gentrric on 2002-09-25 19:35

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Andrew Poulsom

MrExcel MVP
Try this:

Code:
``````Sub Test()
Dim ShSource As Worksheet
Dim ShTarget As Worksheet
Dim RowSource As Long
Dim ColSource As Integer
Dim RowTarget As Long
Dim ColTarget As Integer
Dim x As Integer
'   *** Change name of source sheet to suit ***
Set ShSource = Sheets("Sheet1")
'   *** Change address of first cell in source range to suit ***
RowSource = ShSource.Range("A1").Row
ColSource = 4
RowTarget = 1
'   Create target worksheet
With ShTarget
For x = 1 To ColSource
Cells(RowTarget, x) = ShSource.Cells(RowSource, x)
Next x
End With
RowSource = RowSource + 1
RowTarget = RowTarget + 1
ColTarget = 4
Do
'       All done if nothing in Column A on source sheet
If IsEmpty(ShSource.Cells(RowSource, 1)) Then Exit Do
If IsEmpty(ShSource.Cells(RowSource, ColSource)) Then
'           Next record
RowSource = RowSource + 1
ColSource = 4
Else
'           Next participant
For x = 1 To 3
ShTarget.Cells(RowTarget, x) = ShSource.Cells(RowSource, x)
Next x
ShTarget.Cells(RowTarget, ColTarget) = ShSource.Cells(RowSource, ColSource)
RowTarget = RowTarget + 1
ColSource = ColSource + 1
End If
Loop
End Sub``````

[No message]

gentrric

New Member
Thanks for taking the time to supply me with this code. I'm only beginning my VB experience, but I think I know enough to understand a little of this code. It worked fine, but only for the first 4 columns. I was able to edit it some, but not the right way to make it work. If it makes a differance, the longest row has data in the 40th column. I have about 1100 rows. Some rows only have data in the first 3-4 columns. None of the rows have data in all 40 columns. How else can the code be edited to grab all of the data and keep it together?

Andrew Poulsom

MrExcel MVP
As you have seen my code assumed a contiguous list of participants in each row. This will allow for blanks in the columns provided that all columns contain the heading:

Code:
``````Sub Test()
Dim ShSource As Worksheet
Dim ShTarget As Worksheet
Dim RowSource As Long
Dim LastCol As Integer
Dim ColSource As Integer
Dim RowTarget As Long
Dim ColTarget As Integer
Dim x As Integer
'   *** Change name of source sheet to suit ***
Set ShSource = Sheets("Sheet1")
'   *** Change address of first cell in source range to suit ***
RowSource = ShSource.Range("A1").Row
'   *** Change row number (headings) to suit ***
LastCol = ShSource.Range("IV1").End(xlToLeft).Column
ColSource = 4
RowTarget = 1
'   Create target worksheet
With ShTarget
For x = 1 To ColSource
Cells(RowTarget, x) = ShSource.Cells(RowSource, x)
Next x
End With
RowSource = RowSource + 1
RowTarget = RowTarget + 1
ColTarget = 4
Do
'       All done if nothing in Column A on source sheet
If IsEmpty(ShSource.Cells(RowSource, 1)) Then Exit Do
If IsEmpty(ShSource.Cells(RowSource, ColSource)) Then
'           No Participant
ColSource = ColSource + 1
Else
'           Next participant
For x = 1 To 3
ShTarget.Cells(RowTarget, x) = ShSource.Cells(RowSource, x)
Next x
ShTarget.Cells(RowTarget, ColTarget) = ShSource.Cells(RowSource, ColSource)
RowTarget = RowTarget + 1
ColSource = ColSource + 1
End If
If ColSource > LastCol Then
'           Next record
RowSource = RowSource + 1
ColSource = 4
End If
Loop
End Sub``````

Replies
0
Views
132
Replies
4
Views
469
Replies
3
Views
284
Replies
4
Views
303
Replies
10
Views
222

1,148,195
Messages
5,745,285
Members
423,942
Latest member
excelhelp1423

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back