ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   move offsetting values (https://www.excelbanter.com/excel-programming/397668-move-offsetting-values.html)

Don S

move offsetting values
 
Have data that looks like this

100-
100
100-
98-
98
97-
97-
97

Data will be sorted in descending absolute value order. If 2 lines offset,
need to move lines to another worksheet. If all matching lines on value do
not offset to zero, leave alone. THANKS for any help...

Keithlo

move offsetting values
 
My first recommendation is that rather than move things to a different
worksheet, you first make a copy of the sheet, and then make a macro for each
sheet, one that deletes all items that net to zero, and the other to delete
all items that don't net to zero. Result will be the same, but easier to
code in my opinion.

I will try to come up with code for the macros and send it in a separate
reply if I have time.

Keith

"Don S" wrote:

Have data that looks like this

100-
100
100-
98-
98
97-
97-
97

Data will be sorted in descending absolute value order. If 2 lines offset,
need to move lines to another worksheet. If all matching lines on value do
not offset to zero, leave alone. THANKS for any help...


Keithlo

move offsetting values
 
Here's a macro to remove the ones that net to zero (assuming you are taking
my advice to copy the sheet first and run two macros, one to remove net
zeros, and the other to remove those that don't net to zero).

Sub RemoveNetZeros()
Dim MyFirstRow, MyLastRow As Long
Dim MyValue As Double

Do While ActiveCell.Value < ""

Do Until Abs(ActiveCell.Value) < Abs(ActiveCell.Offset(1, 0).Value)
If Abs(ActiveCell.Value) = Abs(ActiveCell.Offset(1, 0).Value) And _
Abs(ActiveCell.Value) < Abs(ActiveCell.Offset(-1, 0).Value) Then
MyFirstRow = ActiveCell.Row
End If

MyValue = MyValue + ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
MyLastRow = ActiveCell.Row
MyValue = MyValue + ActiveCell.Value
If MyValue = 0 Then
Range(Cells(MyFirstRow, ActiveCell.Column), Cells(MyLastRow,
ActiveCell.Column)).Select
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
MyValue = 0
Loop

End Sub

You start this macro with the activecell being the first value at the top
(row 2 if you have labels in row 1).

As always, test on sample data first to make sure desired results are
obtained. I tested and it worked for me, regardless of the data in the first
few rows, which is where the macro would have been most likely to fail. For
example, I tested it on the first absolute value being in row one only, in
rows one and two only, and in rows one through three only. Worked on all for
me.

Hope this helps. I'll try to send the macro to remove those that don't net
to zero if time allows.

Keith

"Don S" wrote:

Have data that looks like this

100-
100
100-
98-
98
97-
97-
97

Data will be sorted in descending absolute value order. If 2 lines offset,
need to move lines to another worksheet. If all matching lines on value do
not offset to zero, leave alone. THANKS for any help...


Don S

move offsetting values
 
Instead of Entirerow .delete , could you cut and paste to diifferent
worksheet at that point?

"Keithlo" wrote:

Here's a macro to remove the ones that net to zero (assuming you are taking
my advice to copy the sheet first and run two macros, one to remove net
zeros, and the other to remove those that don't net to zero).

Sub RemoveNetZeros()
Dim MyFirstRow, MyLastRow As Long
Dim MyValue As Double

Do While ActiveCell.Value < ""

Do Until Abs(ActiveCell.Value) < Abs(ActiveCell.Offset(1, 0).Value)
If Abs(ActiveCell.Value) = Abs(ActiveCell.Offset(1, 0).Value) And _
Abs(ActiveCell.Value) < Abs(ActiveCell.Offset(-1, 0).Value) Then
MyFirstRow = ActiveCell.Row
End If

MyValue = MyValue + ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
MyLastRow = ActiveCell.Row
MyValue = MyValue + ActiveCell.Value
If MyValue = 0 Then
Range(Cells(MyFirstRow, ActiveCell.Column), Cells(MyLastRow,
ActiveCell.Column)).Select
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
MyValue = 0
Loop

End Sub

You start this macro with the activecell being the first value at the top
(row 2 if you have labels in row 1).

As always, test on sample data first to make sure desired results are
obtained. I tested and it worked for me, regardless of the data in the first
few rows, which is where the macro would have been most likely to fail. For
example, I tested it on the first absolute value being in row one only, in
rows one and two only, and in rows one through three only. Worked on all for
me.

Hope this helps. I'll try to send the macro to remove those that don't net
to zero if time allows.

Keith

"Don S" wrote:

Have data that looks like this

100-
100
100-
98-
98
97-
97-
97

Data will be sorted in descending absolute value order. If 2 lines offset,
need to move lines to another worksheet. If all matching lines on value do
not offset to zero, leave alone. THANKS for any help...


Keithlo

move offsetting values
 
Sure. You just need to change the part of the code that deletes rows to
instead have it cut, select the new sheet, paste at the correct location,
then switch back to the original sheet and continue. As I said in my
original reply, that method will require more code and complexity in my
opinion, which is why I recommend this other way. Also, this way achieves
the same result. You can take this code and modify it, since the basic logic
is there. You can use the macro recorder to get the code for cut and paste.

Keith

"Don S" wrote:

Instead of Entirerow .delete , could you cut and paste to diifferent
worksheet at that point?

"Keithlo" wrote:

Here's a macro to remove the ones that net to zero (assuming you are taking
my advice to copy the sheet first and run two macros, one to remove net
zeros, and the other to remove those that don't net to zero).

Sub RemoveNetZeros()
Dim MyFirstRow, MyLastRow As Long
Dim MyValue As Double

Do While ActiveCell.Value < ""

Do Until Abs(ActiveCell.Value) < Abs(ActiveCell.Offset(1, 0).Value)
If Abs(ActiveCell.Value) = Abs(ActiveCell.Offset(1, 0).Value) And _
Abs(ActiveCell.Value) < Abs(ActiveCell.Offset(-1, 0).Value) Then
MyFirstRow = ActiveCell.Row
End If

MyValue = MyValue + ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
MyLastRow = ActiveCell.Row
MyValue = MyValue + ActiveCell.Value
If MyValue = 0 Then
Range(Cells(MyFirstRow, ActiveCell.Column), Cells(MyLastRow,
ActiveCell.Column)).Select
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
MyValue = 0
Loop

End Sub

You start this macro with the activecell being the first value at the top
(row 2 if you have labels in row 1).

As always, test on sample data first to make sure desired results are
obtained. I tested and it worked for me, regardless of the data in the first
few rows, which is where the macro would have been most likely to fail. For
example, I tested it on the first absolute value being in row one only, in
rows one and two only, and in rows one through three only. Worked on all for
me.

Hope this helps. I'll try to send the macro to remove those that don't net
to zero if time allows.

Keith

"Don S" wrote:

Have data that looks like this

100-
100
100-
98-
98
97-
97-
97

Data will be sorted in descending absolute value order. If 2 lines offset,
need to move lines to another worksheet. If all matching lines on value do
not offset to zero, leave alone. THANKS for any help...


Don S

move offsetting values
 
THANKS for all your help.......

"Keithlo" wrote:

Sure. You just need to change the part of the code that deletes rows to
instead have it cut, select the new sheet, paste at the correct location,
then switch back to the original sheet and continue. As I said in my
original reply, that method will require more code and complexity in my
opinion, which is why I recommend this other way. Also, this way achieves
the same result. You can take this code and modify it, since the basic logic
is there. You can use the macro recorder to get the code for cut and paste.

Keith

"Don S" wrote:

Instead of Entirerow .delete , could you cut and paste to diifferent
worksheet at that point?

"Keithlo" wrote:

Here's a macro to remove the ones that net to zero (assuming you are taking
my advice to copy the sheet first and run two macros, one to remove net
zeros, and the other to remove those that don't net to zero).

Sub RemoveNetZeros()
Dim MyFirstRow, MyLastRow As Long
Dim MyValue As Double

Do While ActiveCell.Value < ""

Do Until Abs(ActiveCell.Value) < Abs(ActiveCell.Offset(1, 0).Value)
If Abs(ActiveCell.Value) = Abs(ActiveCell.Offset(1, 0).Value) And _
Abs(ActiveCell.Value) < Abs(ActiveCell.Offset(-1, 0).Value) Then
MyFirstRow = ActiveCell.Row
End If

MyValue = MyValue + ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
MyLastRow = ActiveCell.Row
MyValue = MyValue + ActiveCell.Value
If MyValue = 0 Then
Range(Cells(MyFirstRow, ActiveCell.Column), Cells(MyLastRow,
ActiveCell.Column)).Select
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
MyValue = 0
Loop

End Sub

You start this macro with the activecell being the first value at the top
(row 2 if you have labels in row 1).

As always, test on sample data first to make sure desired results are
obtained. I tested and it worked for me, regardless of the data in the first
few rows, which is where the macro would have been most likely to fail. For
example, I tested it on the first absolute value being in row one only, in
rows one and two only, and in rows one through three only. Worked on all for
me.

Hope this helps. I'll try to send the macro to remove those that don't net
to zero if time allows.

Keith

"Don S" wrote:

Have data that looks like this

100-
100
100-
98-
98
97-
97-
97

Data will be sorted in descending absolute value order. If 2 lines offset,
need to move lines to another worksheet. If all matching lines on value do
not offset to zero, leave alone. THANKS for any help...



All times are GMT +1. The time now is 12:39 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com