How to loop a macro?

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

a - 07 Jul 2007 18:12 GMT

I need to manipulate an excel file that contains relay results from a summer
swim leauge. I need to take a row that looks like this:

TEAM DATE MEET SWIMMER1 SWIMMER2 SWIMMER3 SWIMMER4

and turn it into 4 rows that look like this

SWIMMER1 TEAM DATE MEET
SWIMMER2 TEAM DATE MEET
SWIMMER3 TEAM DATE MEET
SWIMMER4 TEAM DATE MEET

I got as far as creating the macro below but it keeps going back to the same
line 6 and repeaqting the insert...

How do I modify this to go to the next line down?

Is it possible to loop the macro so that it will process all 1300 lines in
my spreadsheet?

The currnet Macro looks like:

Sub AMSA()
'
' AMSA Macro
' Macro recorded 7/7/2007 by cduchon
'
' Keyboard Shortcut: Ctrl+Shift+A
'
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A6:C6").Select
Range("C6").Activate
Selection.Copy
Range("A7:C9").Select
ActiveSheet.Paste
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("F6").Select
Application.CutCopyMode = False
Selection.Copy
Range("D8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("G6").Select
Application.CutCopyMode = False
Selection.Copy
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A10").Select
End Sub

Reply to this Message

Bob Phillips - 07 Jul 2007 18:50 GMT

Option Explicit

Sub ProcessData()
Dim iLastrow As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

iLastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastrow To 2 Step -1
.Rows(i + 1).Resize(3).Insert
.Cells(i + 1, "A").Value = .Cells(i, "D").Value
.Cells(i + 1, "B").Value = .Cells(i, "A").Value
.Cells(i + 1, "C").Value = .Cells(i, "B").Value
.Cells(i + 1, "D").Value = .Cells(i, "C").Value
.Cells(i + 2, "A").Value = .Cells(i, "E").Value
.Cells(i + 2, "B").Value = .Cells(i, "A").Value
.Cells(i + 2, "C").Value = .Cells(i, "B").Value
.Cells(i + 2, "D").Value = .Cells(i, "C").Value
.Cells(i + 3, "A").Value = .Cells(i, "F").Value
.Cells(i + 3, "B").Value = .Cells(i, "A").Value
.Cells(i + 3, "C").Value = .Cells(i, "B").Value
.Cells(i + 3, "D").Value = .Cells(i, "C").Value
.Cells(i, "A").Insert Shift:=xlToRight
.Cells(i, "A").Value = .Cells(i, "E").Value
.Cells(i, "E").Resize(, 4).ClearContents
Next i
End With
End Sub

> I need to manipulate an excel file that contains relay results from a summer
> swim leauge. I need to take a row that looks like this:
[quoted text clipped - 56 lines]
> Range("A10").Select
> End Sub

Reply to this Message

a - 07 Jul 2007 19:20 GMT

Thanks.

> Option Explicit
>
[quoted text clipped - 91 lines]
>> Range("A10").Select
>> End Sub

Reply to this Message

Dana DeLouis - 08 Jul 2007 19:59 GMT

Here's my technique on doing something similar:

Sub Demo()
Dim D As Variant
Dim R As Long '(R)ow
Dim C As Long '(C)olumn
Dim M As Variant
Dim Rec As Long

Set D = CreateObject("Scripting.Dictionary")

M = [A1].CurrentRegion.Value
For R = 2 To UBound(M, 1)
For C = 4 To 7
Rec = Rec + 1
D.Add Rec, Array(M(R, C), M(R, 1), M(R, 2), M(R, 3))
Next C
Next R

[A1].CurrentRegion.Clear
[A2].Resize(D.Count, 4) = T2(D.items)
With [A1:D1]
.Value = Array("Swimmer", "Team", "Date", "Meet")
.EntireColumn.AutoFit
End With
End Sub

' T2 is one of my common Library Functions:

Private Function T2(v)
' Transpose twice.
With WorksheetFunction
T2 = .Transpose(.Transpose(v))
End With
End Function

Signature

HTH :>)
Dana DeLouis
Windows XP & Excel 2007

> Thanks.
>
[quoted text clipped - 93 lines]
>>> Range("A10").Select
>>> End Sub

Reply to this Message