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

Sub AlterDate()
Dim varr, varr1
Dim i As Long, j As Long, lastrow As Long

varr = Array("E2", "D3", "D4", "E3", "B6")
varr1 = Array("F1", "G1", "H1", "I1", "J1")

If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow / 8
For j = LBound(varr) To UBound(varr)
Range(varr1(j)).Offset((i - 1) * 8).Value = _
Range(varr(j)).Offset((i - 1) * 8).Value
Next
Next

For i = lastrow To 8 Step -8
Cells(i, 1).Offset(-6, 0). _
Resize(7).EntireRow.Delete
Next

End Sub

Test this on a copy of your worksheet. Works on the active sheet.

Regards,
Tom Ogilvy

David Patterson wrote in message
...
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

I left off the delete columns B to E. Here is the adjusted code:

Sub AlterDate()
Dim varr, varr1
Dim i As Long, j As Long, lastrow As Long

varr = Array("E2", "D3", "D4", "E3", "B6")
varr1 = Array("F1", "G1", "H1", "I1", "J1")

If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow / 8
For j = LBound(varr) To UBound(varr)
Range(varr1(j)).Offset((i - 1) * 8).Value = _
Range(varr(j)).Offset((i - 1) * 8).Value
Next
Next

For i = lastrow To 8 Step -8
Cells(i, 1).Offset(-6, 0). _
Resize(7).EntireRow.Delete
Next

Range("B1:E1").EntireColumn.Delete

End Sub

--
Regards,
Tom Ogilvy

Tom Ogilvy wrote in message
...
Sub AlterDate()
Dim varr, varr1
Dim i As Long, j As Long, lastrow As Long

varr = Array("E2", "D3", "D4", "E3", "B6")
varr1 = Array("F1", "G1", "H1", "I1", "J1")

If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow / 8
For j = LBound(varr) To UBound(varr)
Range(varr1(j)).Offset((i - 1) * 8).Value = _
Range(varr(j)).Offset((i - 1) * 8).Value
Next
Next

For i = lastrow To 8 Step -8
Cells(i, 1).Offset(-6, 0). _
Resize(7).EntireRow.Delete
Next

End Sub

Test this on a copy of your worksheet. Works on the active sheet.

Regards,
Tom Ogilvy

David Patterson wrote in message
...
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

I think Tom wants this:

lastrow = Cells(Rows.Count, 1).End(xlUp).Row
If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If




Tom Ogilvy wrote:

I left off the delete columns B to E. Here is the adjusted code:

Sub AlterDate()
Dim varr, varr1
Dim i As Long, j As Long, lastrow As Long

varr = Array("E2", "D3", "D4", "E3", "B6")
varr1 = Array("F1", "G1", "H1", "I1", "J1")

If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow / 8
For j = LBound(varr) To UBound(varr)
Range(varr1(j)).Offset((i - 1) * 8).Value = _
Range(varr(j)).Offset((i - 1) * 8).Value
Next
Next

For i = lastrow To 8 Step -8
Cells(i, 1).Offset(-6, 0). _
Resize(7).EntireRow.Delete
Next

Range("B1:E1").EntireColumn.Delete

End Sub

--
Regards,
Tom Ogilvy

Tom Ogilvy wrote in message
...
Sub AlterDate()
Dim varr, varr1
Dim i As Long, j As Long, lastrow As Long

varr = Array("E2", "D3", "D4", "E3", "B6")
varr1 = Array("F1", "G1", "H1", "I1", "J1")

If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow / 8
For j = LBound(varr) To UBound(varr)
Range(varr1(j)).Offset((i - 1) * 8).Value = _
Range(varr(j)).Offset((i - 1) * 8).Value
Next
Next

For i = lastrow To 8 Step -8
Cells(i, 1).Offset(-6, 0). _
Resize(7).EntireRow.Delete
Next

End Sub

Test this on a copy of your worksheet. Works on the active sheet.

Regards,
Tom Ogilvy

David Patterson wrote in message
...
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





--

Dave Peterson

As suggested, I check that the number of rows is divisible by 8 before I get
the number of rows - not a problem if the test would be passed anyway, but
to accomplish the intent:

Sub AlterDate()
Dim varr, varr1
Dim i As Long, j As Long, lastrow As Long

varr = Array("E2", "D3", "D4", "E3", "B6")
varr1 = Array("F1", "G1", "H1", "I1", "J1")

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If


For i = 1 To lastrow / 8
For j = LBound(varr) To UBound(varr)
Range(varr1(j)).Offset((i - 1) * 8).Value = _
Range(varr(j)).Offset((i - 1) * 8).Value
Next
Next

For i = lastrow To 8 Step -8
Cells(i, 1).Offset(-6, 0). _
Resize(7).EntireRow.Delete
Next

Range("B1:E1").EntireColumn.Delete

End Sub

Tom Ogilvy wrote in message
...
I left off the delete columns B to E. Here is the adjusted code:

Sub AlterDate()
Dim varr, varr1
Dim i As Long, j As Long, lastrow As Long

varr = Array("E2", "D3", "D4", "E3", "B6")
varr1 = Array("F1", "G1", "H1", "I1", "J1")

If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow / 8
For j = LBound(varr) To UBound(varr)
Range(varr1(j)).Offset((i - 1) * 8).Value = _
Range(varr(j)).Offset((i - 1) * 8).Value
Next
Next

For i = lastrow To 8 Step -8
Cells(i, 1).Offset(-6, 0). _
Resize(7).EntireRow.Delete
Next

Range("B1:E1").EntireColumn.Delete

End Sub

--
Regards,
Tom Ogilvy

Tom Ogilvy wrote in message
...
Sub AlterDate()
Dim varr, varr1
Dim i As Long, j As Long, lastrow As Long

varr = Array("E2", "D3", "D4", "E3", "B6")
varr1 = Array("F1", "G1", "H1", "I1", "J1")

If lastrow Mod 8 < 0 Then
MsgBox "Number of rows not evenly divisible by 8"
Exit Sub
End If
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow / 8
For j = LBound(varr) To UBound(varr)
Range(varr1(j)).Offset((i - 1) * 8).Value = _
Range(varr(j)).Offset((i - 1) * 8).Value
Next
Next

For i = lastrow To 8 Step -8
Cells(i, 1).Offset(-6, 0). _
Resize(7).EntireRow.Delete
Next

End Sub

Test this on a copy of your worksheet. Works on the active sheet.

Regards,
Tom Ogilvy

David Patterson wrote in message
...
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

You could loop through the rows:

Option Explicit
Sub testme02()

'E2 to F1, D3 to G1, D4 to H1, E3 to I1 and B6 to J1

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim delRng As Range

With ActiveSheet
FirstRow = 1
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For iRow = FirstRow To LastRow Step 8
.Cells(iRow, "F").Value = .Cells(iRow + 1, "E").Value
.Cells(iRow, "G").Value = .Cells(iRow + 2, "D").Value
.Cells(iRow, "H").Value = .Cells(iRow + 3, "D").Value
.Cells(iRow, "I").Value = .Cells(iRow + 2, "E").Value
.Cells(iRow, "J").Value = .Cells(iRow + 5, "b").Value
If delRng Is Nothing Then
Set delRng = .Cells(iRow + 1, "A").Resize(7)
Else
Set delRng = Union(delRng, .Cells(iRow + 1, "A").Resize(7))
End If
Next iRow

If delRng Is Nothing Then
'do nothing
Else
delRng.EntireRow.Delete
End If
End With

End Sub

But if I were doing it by hand, I'd put 5 formulas in F1:J1 and drag down. Then
I'd use a helper column with this kind of formula in it:

=if(MOD(ROW(),8)-1=0,"keep",NA())

then I'd select column A and do Edit|Goto Special and select Formulas (and
uncheck everything but errors).

Then I'd right click on part of that selection and delete (entire row).

Then delete the helper column.

In code, it would could like this:

Option Explicit
Sub testme01()

'E2 to F1, D3 to G1, D4 to H1, E3 to I1 and B6 to J1
Dim LastRow As Long

With ActiveSheet
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row

.Range("F1:F" & LastRow).Formula = "=E2"
.Range("G1:g" & LastRow).Formula = "=D3"
.Range("H1:h" & LastRow).Formula = "=d4"
.Range("i1:i" & LastRow).Formula = "=e3"
.Range("j1:j" & LastRow).Formula = "=b6"
With .Range("F1:J" & LastRow)
.Value = .Value
End With

.Columns(1).Insert
.Range("a1:a" & LastRow).Formula _
= "=if(MOD(ROW(),8)-1=0,""keep"",NA())"
On Error Resume Next
.Range("A:A").Cells.SpecialCells(xlCellTypeFormula s, xlErrors) _
.EntireRow.Delete
.Columns(1).Delete

End With
End Sub



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

--

Dave Peterson

Hi, Dave:

RE doing it manually: I think you omitted converting the formulas in F:I to
their values. You need to do this before deleting rows.

Myrna Larson


"Dave Peterson" wrote in message
...
You could loop through the rows:

Option Explicit
Sub testme02()

'E2 to F1, D3 to G1, D4 to H1, E3 to I1 and B6 to J1

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim delRng As Range

With ActiveSheet
FirstRow = 1
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For iRow = FirstRow To LastRow Step 8
.Cells(iRow, "F").Value = .Cells(iRow + 1, "E").Value
.Cells(iRow, "G").Value = .Cells(iRow + 2, "D").Value
.Cells(iRow, "H").Value = .Cells(iRow + 3, "D").Value
.Cells(iRow, "I").Value = .Cells(iRow + 2, "E").Value
.Cells(iRow, "J").Value = .Cells(iRow + 5, "b").Value
If delRng Is Nothing Then
Set delRng = .Cells(iRow + 1, "A").Resize(7)
Else
Set delRng = Union(delRng, .Cells(iRow + 1,
"A").Resize(7))
End If
Next iRow

If delRng Is Nothing Then
'do nothing
Else
delRng.EntireRow.Delete
End If
End With

End Sub

But if I were doing it by hand, I'd put 5 formulas in F1:J1 and drag down.
Then
I'd use a helper column with this kind of formula in it:

=if(MOD(ROW(),8)-1=0,"keep",NA())

then I'd select column A and do Edit|Goto Special and select Formulas (and
uncheck everything but errors).

Then I'd right click on part of that selection and delete (entire row).

Then delete the helper column.

In code, it would could like this:

Option Explicit
Sub testme01()

'E2 to F1, D3 to G1, D4 to H1, E3 to I1 and B6 to J1
Dim LastRow As Long

With ActiveSheet
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row

.Range("F1:F" & LastRow).Formula = "=E2"
.Range("G1:g" & LastRow).Formula = "=D3"
.Range("H1:h" & LastRow).Formula = "=d4"
.Range("i1:i" & LastRow).Formula = "=e3"
.Range("j1:j" & LastRow).Formula = "=b6"
With .Range("F1:J" & LastRow)
.Value = .Value
End With

.Columns(1).Insert
.Range("a1:a" & LastRow).Formula _
= "=if(MOD(ROW(),8)-1=0,""keep"",NA())"
On Error Resume Next
.Range("A:A").Cells.SpecialCells(xlCellTypeFormula s, xlErrors) _
.EntireRow.Delete
.Columns(1).Delete

End With
End Sub



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

--

Dave Peterson

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

Thanks guys and girls for your help. It's worked fine.

David.
"David Patterson" wrote in message
...
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