Repeating (Looping) a Macro
Personally, I would write two loops, the first to move the data, the 2nd to delete the extra
rows. I think the following is correct. I would try it on a copy of your file first. The sheet
to be manipulated must be the active sheet at the time you run the macro.
Sub MoveData()
Dim Data As Variant
Dim Keep As Variant
Dim LastRow As Long
Dim R As Long
Dim SaveRow As Long
Application.ScreenUpdating = False
'find the last row -- based on assumption there's always data in column A
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For R = 1 To LastRow Step 8
'1st pass will get data from A1:E6 into a VBA array
'2nd pass from A9:E14, 3rd from A17:E22, etc.
Data = Cells(R, 1).Resize(6, 4).Value
'references in next comment are to 1st pass; rows will increase by 8 on each pass
'keep values from E2 D3 D4 E3 B6
Keep = Array(Data(2, 5), Data(3, 4), Data(4, 4), Data(3, 5), Data(6, 2))
'put this into columns F:J of current row
Cells(R, 6).Resize(1, 5).Value = Keep
SaveRow = R 'save row number
Next R
'work from bottom up to delete rows
For R = SaveRow To 1 Step - 8
'keep row R, delete the 7 rows below it
Cells(R + 1, 1).Resize(7, 1).EntireRow.Delete
Next R
'delete columns E and B (work from right to left!)
Columns(5).EntireColumn.Delete
Columns(2).EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
On Sun, 3 Aug 2003 23:14:59 +0000 (UTC), "David Patterson"
wrote:
I'm a beginner in writing code for macros and I'm struggling here. We have
a file concerning accounting entry details that comes from the mainframe
that has more information than I need. Unfortunately, the additional detail
cannot be stripped out before it is sent. Information about each entry
consists of 8 rows and a number of columns. I want to put all the relevant
information I want on to one line and delete the redundant rows and columns.
I want to move E2 to F1, D3 to G1, D4 to H1, E3 to I1 and B6 to J1. I can
do that but how do I get the macro to repeat this manoeuvre throughout the
file? All the increments will be by 8 rows. I then need to delete rows 2
to 8, then 10 to 16 and so on finishing off with deleting columns B to E.
I'm using Excel 97 at work and XP at home.
Thanks,
David
|