macro for rearranging data

[Guest]

Hi,
I need some help, please. I have to rearrange data in my worksheet that
looks like this:

A B
WALNUT
NUMBER VISITS 2
CHARGES($000) 2.0
%PAID($) 83.57
LOMPOC
NUMBER VISITS 3
CHARGES($000) 3.3
%PAID($) 31.07
HILMAR
NUMBER VISITS 1
CHARGES($000) 2.1
%PAID($) 18.01
WINTHROP
NUMBER VISITS 1
CHARGES($000) 1.5
%PAID($) 95

into the horizontal view like that.

A B C D
WALNUT 2 2.0 83.57
LOMPOC 3 3.3 31.07
HILMAR 1 2.1 18.01
WINTHROP 1 1.5 95

I’ve been using “Copy and Past Special†with Transpose option, and it worked
well, but my worksheet is so huge that it will take forever for me to do so.
I recorded a Macro, but don’t know how to tell to start at the beginning and
go across the sheet. Could some one help me, please with a Macro here?

Thanks so much,

Lu.

 

[Guest]

This code drops the rearranged data onto a seperate sheet. It assumes the
source data is on sheet 1 columns A2:A???. It puts the new data onto sheet
2... You can change those to suite (you just need to change the stuff between
the quotes "Sheet1", "Sheet2", "A2", "A")

Sub MoveStuff()
Dim rngToSearch As Range
Dim rngPaste As Range
Dim rng As Range
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim intCounter As Integer

Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")

With wksCopyFrom
Set rngToSearch = .Range(.Range("A2"), .Cells(Rows.Count, "A").End(xlUp))
End With
wksCopyTo.Cells.ClearContents
Set rngPaste = wksCopyTo.Range("A2")

intCounter = 0
For Each rng In rngToSearch
If intCounter = 0 Then
rngPaste.Offset(0, intCounter).Value = rng.Value
Else
rngPaste.Offset(0, intCounter).Value = rng.Offset(0, 1).Value
End If
intCounter = intCounter + 1
If intCounter = 4 Then
intCounter = 0
Set rngPaste = rngPaste.Offset(1, 0)
End If
Next rng

End Sub

 

[Guest]

Thank you, Jim.

It was amazing!!!
I wish I could be as clever...

Lu.

 

[Justin810]

I tried to apply this macro to my problem (very similar), but cant seem
to get it to repeat itself over multiple columns(I am a beginner). I
am using a data set that repeats every seven rows, and need these rows
to cover 7 columns instead. Could someone help me figure this out?

 

[Die_Another_Day]

Sub MoveStuff()
Dim rngToSearch As Range
Dim rngPaste As Range
Dim rng As Range
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim intCounter As Integer


Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")


With wksCopyFrom
Set rngToSearch = .Range(.Range("A2"), .Cells(Rows.Count,
"A").End(xlUp))
End With
wksCopyTo.Cells.ClearContents
Set rngPaste = wksCopyTo.Range("A2")


intCounter = 0
For Each rng In rngToSearch
If intCounter = 0 Then
rngPaste.Offset(0, intCounter).Value = rng.Value
Else
rngPaste.Offset(0, intCounter).Value = rng.Offset(0,
1).Value
End If
intCounter = intCounter + 1
If intCounter = 7 Then 'I think this is all that needs
changed. It says to copy across columns til you get to 7 then goto the
first column and the next row
intCounter = 0
Set rngPaste = rngPaste.Offset(1, 0)
End If
Next rng


End Sub

HTH

Die_Another_Day

 

[Justin810]

Yeah, I have been trying it that way too. But still, only column A gets
used. The only way I have successfully added to column B is by:

With wksCopyFrom
Set rngToSearch = .Range(.Range("A3"), .Cells(Rows.Count,
"A").End(xlUp))
End With
wksCopyTo.Cells.ClearContents
Set rngPaste = wksCopyTo.Range("B2")

And if I created 7 total macros (near-carbon copies, but for columns
A-F), each one overwrites the other.

 

[Die_Another_Day]

I'm not understanding you. Is your source data already in multiple
columns?

Die_Another_Day

 

[Justin810]

No

My source data originates on sheet one A2, and goes down colum A for 6
inputs, then has an empty cell and continues for the next 6 inputs. So
if I use the macro as is (with 7 for the int), it does a great job of
taking the first of every data set and separating it into column A of
sheet 2. But nothing happens to the rest of the data(A2-A7, A9-A16,
and so forth). If I activate the macro with pre-existing text, it will
erase anything previously on the sheet (even if it is far away from the
new data). Thus I cant run several macros for each data item and
column (Ie A3 to B2). When you said "drag accross columns," what did
you mean?

I appreciate all of the help. I kinda figured out a way around this
through find and replace formating in word, but know the the macros
will leave much less room for error...hopefully. I noticed in past
macros I've run, they always leave the rest of the sheet in tact,
bedside the region they are running over. Is their a part of this
code that clears pre-existing content?