Need help with recorded macro

[Guest]

Hello,
My project involves copying a row of 5 numbers, transpose to another column,
sort the column, then transpose back to the original location, then move to
the next row an repeat.

I have the following macro I created using the macro recorder. I’m not VBA
savvy. The macro does the job I need, however, I have 261 rows in my sheet
that I need this to perform. I do not know how to get the macro to move to
the row, perform the steps and move to the next and so on.

Will someone please show me how to adjust my code to finish my project?
Thanks in advance.

Sub transpose()
'
' transpose Macro
' Copy, transpose, sort, transpose multiple rows
'

'
Range("B4:F4").Select NEED TO MOVE TO NEXT ROW AFTER THE MACRO
COMPLETES
Selection.Copy
Range("G3").Select THIS CAN REMAIN STATIC
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, transpose:=True
Application.CutCopyMode = False
Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Copy
Range("B4").Select this needs to adjust to the next cell down as the
macro completes a cycle
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, transpose:=True
End Sub

 

[Vasant Nanavati]

(Untested)

(Haven't checked your code; assuming it works)

Dim i As Integer
For i = 1 To 261
Range("B4:F4").Offset(i - 1, 0).Select NEED TO MOVE TO NEXT ROW AFTER THE
MACRO
COMPLETES
Selection.Copy
Range("G3").Select THIS CAN REMAIN STATIC
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, transpose:=True
Application.CutCopyMode = False
Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Copy
Range("B4").Offset(i - 1, 0).Select this needs to adjust to the next
cell down as the
macro completes a cycle
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, transpose:=True
Next i
End Sub

I'd advise getting away from all the selecting, though.
___________________________________________________________________________

 

[Guest]

Sub Test()
Dim c As Range, r As Range, r2 As Range
Set r = Range(Range("B4"), Range("B4").end(xlDown))
For Each c In r.Cells
Set r2 = c.Resize(1, 4)
With Range("G3").Resize(4, 1)
.Value = Application.transpose(r2.Value)
.Sort Key1:=Range("G3"), Order1:=xlAscending
r2.Value = Application.transpose(.Value)
.ClearContents
End With
Next
End Sub

 

[JHL]

Thank You, your changes worked. As I mentioned I'm do not know VBA
programming and created this using the macro recorded. If you have time, I
would surly use a more creative and efficient model if you provide. Thanks
again.

 

[JHL]

Greg
I'm sorry but your macro does not work. I ran as if it cycled through the
entire 200+ rows of data, but nothing was ultimately re-sorted, except the
first item it processed.

 

[JHL]

Greg
I did a 'step thru' and your code transfers 4 of the 5 numbers to cell G3.
The 5th number isn't there. It sorts the 4 numbers in G3, but doesn't
transpose them back to their original location.

 

[Guest]

I had an error on the range size. The following corrects this and includes
additional code to make it faster. It works as far as I understand your
situation. However, the previous one should have worked also except would
have been incomplete. I don't know why it didn't transpose the data back to
the original location. I have it working here. I can't think of what would be
different with your worksheet that it wouldn't work with you. Please advise
if this doesn't work and step through it to see where it fails.

Sub Test2()
Dim c As Range
Dim r As Range, r2 As Range, r3 As Range

Set r = Range(Range("B4"), Range("B4").end(xlDown))
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
For Each c In r.Cells
Set r2 = c.Resize(1, 5)
Set r3 = Range("G3").Resize(5, 1)
r3.Value = .transpose(r2.Value)
r3.Sort Key1:=Range("G3"), Order1:=xlAscending
r2.Value = .transpose(r3.Value)
r3.ClearContents
Next
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

 

[Vasant Nanavati]

I would try something like:

Dim i As Integer
For i = 1 To 261
Range("B4:F4").Offset(i - 1, 0).Copy
Range("G3").PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, transpose:=True
Application.CutCopyMode = False
Range("G3:G7").Sort Key1:=Range("G3"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("G3:G7").Copy
Range("B4").Offset(i - 1, 0).PasteSpecial Paste:=xlAll,
Operation:=xlNone, SkipBlanks:=False _
, transpose:=True
Next i

_____________________________________________________________________________________________________________________________________________________________________

 

[JHL]

Greg
this worked better than fast. Ran the macro and literally the next second,
it was done, complete and accurate.
Excellent!

Since this data will grow and I couldn't see where your coded had a
limitation other than Excel's row limit, I can add data and just run your
macro - correct?

 

[JHL]

Vasant
thanks again for your reply. How do you change this so you can keep adding
rows and the macro still runs correctly.

 

[Guest]

You are correct as long as there are no gaps in the data. It can be re-coded
to handle gaps of course. The following line establishes the range:

Set r = Range(Range("B4"), Range("B4").end(xlDown))

It sets it to the contiguous range of cells in column B from B4 on down. If
there is a gap it will stop at the cell above the gap. The data can both grow
and shrink. It will cause a problem if B5 is blank however - i.e. there needs
to be at least 2 rows of data. A workaround can be created if necessary.

Regards,
Greg

 

[Vasant Nanavati]

Low-tech: You can change 261 to the actual number of rows.

Higher-tech: You can change 261 to something like:

Range("B4").End(xlDown).Row - Range("B4").Row + 1

assuming there are no gaps in column B.

________________________________________________________________________