Hi,

I've got a repetitive task I need to do thousands of times per year
which would be a superb candidate for a macro, but I'm trying to
figure out how.

Here is what I have to do.

I've got a range of data which starts with columns like the following:

<field 1 10/08/2007 <field 3 <field 4 <field 5 <field 6 $0.00
<more fields
<field 1 10/08/2007 <field 3 <field 4 <field 5 <field 6 $23.45
<more fields
<field 1 10/08/2007 <field 3 <field 4 <field 5 <field 6 $0.00
<more fields
<field 1 10/08/2007 <field 3 <field 4 <field 5 <field 6 $1.62
<more fields

The date field is important because it determines where in the target
table the rows get inserted and the currency field is important
because I don't want the nil ones.

I need to paste those values into another table in date order. The
target table consists of data in the above format, with varying
dates. The reason why the above all have the same date is because
each time I'm pasting rows into the main table, all those rows have
been extracted from a single payment statement. I'll always be
pasting one or more rows of data with a single date per batch.

What I do manually is I select the above rows, go to the table where
I'm supposed to paste them, scroll until I find the end of August
2007's payments and insert the rows then paste special (values only)
over the top at the end of the month. Then I select the rows with
$0.00 payments and delete them.

I'm ok with basic macro writing so I don't need to be told how to
automate copying and pasting as such, all I want to know is how I can
set the insertion point such that the insert/paste happens and how to
eliminate the rows with zero payment. Whether eliminating the zeros
is done before the copy or after doesn't matter.

Deleting the zero rows is the less important part of the problem, if I
could get an answer on the inserting at the right place part I'd be
happy.

Thanks in advance

Travis

Here's code to delete the rows with zeros in them. Adjust to suit.

Sub Test()
Dim aWS As Excel.Worksheet
Dim myRange As Excel.Range
Dim r As Excel.Range
Dim myDeleteRange As Excel.Range
Set aWS = ActiveSheet

Set myRange = aWS.Cells(2, 7) 'starts range in 2nd row, 7th column
lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).row
If lRow <= myRange.row Then Exit Sub

Set myRange = myRange.Resize(lRow - myRange.row + 1, 1)

For Each r In myRange
If r.Value = 0 Then
If myDeleteRange Is Nothing Then
Set myDeleteRange = r
Else
Set myDeleteRange = Union(myDeleteRange, r)
End If
End If
Next r

If Not myDeleteRange Is Nothing Then
myDeleteRange.EntireRow.Delete
End If

End Sub

--
HTH,
Barb Reinhardt

If this post was helpful to you, please click YES below.



"travis" wrote:

Hi,

I've got a repetitive task I need to do thousands of times per year
which would be a superb candidate for a macro, but I'm trying to
figure out how.

Here is what I have to do.

I've got a range of data which starts with columns like the following:

<field 1 10/08/2007 <field 3 <field 4 <field 5 <field 6 $0.00
<more fields
<field 1 10/08/2007 <field 3 <field 4 <field 5 <field 6 $23.45
<more fields
<field 1 10/08/2007 <field 3 <field 4 <field 5 <field 6 $0.00
<more fields
<field 1 10/08/2007 <field 3 <field 4 <field 5 <field 6 $1.62
<more fields

The date field is important because it determines where in the target
table the rows get inserted and the currency field is important
because I don't want the nil ones.

I need to paste those values into another table in date order. The
target table consists of data in the above format, with varying
dates. The reason why the above all have the same date is because
each time I'm pasting rows into the main table, all those rows have
been extracted from a single payment statement. I'll always be
pasting one or more rows of data with a single date per batch.

What I do manually is I select the above rows, go to the table where
I'm supposed to paste them, scroll until I find the end of August
2007's payments and insert the rows then paste special (values only)
over the top at the end of the month. Then I select the rows with
$0.00 payments and delete them.

I'm ok with basic macro writing so I don't need to be told how to
automate copying and pasting as such, all I want to know is how I can
set the insertion point such that the insert/paste happens and how to
eliminate the rows with zero payment. Whether eliminating the zeros
is done before the copy or after doesn't matter.

Deleting the zero rows is the less important part of the problem, if I
could get an answer on the inserting at the right place part I'd be
happy.

Thanks in advance

Travis

Hi Barb,

Thanks for that. I came up with a solution to the non-zero values
problem last night, but I'm still stumped by the insert in the right
chronological order problem.

Looking through some of my other spreadsheets I found I'd already
cracked the nil values one for a macro I did a couple of years ago to
amend the selected data for a chart, so I wouldn't chart zero series.
With a bit of modification it worked here.

The following function takes a specified range and returns a range
specifying only the rows where the numerical fields (columns 7 to 9)
aren't all zero. This range can be copied and pasted to the target
cell, but I'm still stumped by trying to figure out how to code for
the target row.

Pasting at the end of the data sheet and then running a sort would
work but wouldn't be ideal as occasionally there are pieces of data
which need to be in a specific order other than an exact chronolonical
ordering. (They need to be in the same order as the statement the
data has been copied from, to make it easier to check against the
statement during audit.)

Travis

Function NonZeroCommissions(inputrange As Range) As Range

Dim DownCounter, AcrossCounter, NumberOfRows As Integer
Dim temprange, copyable, upperleft As Range


NumberOfRows = inputrange.Rows.Count


Set upperleft = inputrange.Resize(1, 1)

' Find the first series which isn't all zeros, and name its range
"copyable"

For DownCounter = 0 To NumberOfRows

For AcrossCounter = 7 To 9

If Not upperleft.Offset(DownCounter, AcrossCounter).Value = 0 Then

Set copyable = Range(upperleft.Offset(DownCounter, 0).Address &
":" & upperleft.Offset(DownCounter, 21).Address)

Exit For

End If

Next AcrossCounter

Next DownCounter

' Now build up the rest of the range by adding additional ranges which
also have non zeros

For DownCounter = 0 To NumberOfRows

For AcrossCounter = 7 To 9

If Not upperleft.Offset(DownCounter, AcrossCounter).Value = 0
Then

Set temprange = Range(upperleft.Offset(DownCounter, 0).Address
& ":" & upperleft.Offset(DownCounter, 21).Address)
Set copyable = Union(copyable, temprange)

AcrossCounter = 1

Exit For

End If

Next AcrossCounter


Next DownCounter

Set NonZeroCommissions = copyable

End Function