PDA

View Full Version : Solved: Why does one work but not the other?



Djblois
04-20-2007, 08:22 AM
THis works:

If Range("C" & i) = Range("C" & i).Offset(-1, 0) Then
Cells(i, "C").EntireRow.Delete
End If

This doesn't:

If Range("C" & i) = Range("C" & i).Offset(-2, 0) Then
Cells(i, "C").EntireRow.Delete
End If

I even tried this:

If Cells(i, "C") = Cells(i - 2, "C") Then

and this:

If Range("C" & i) = Range("C" & i - 2) Then

What I ultimatelly want to do it test each cell in the "C" column against the cell in the "C" column 2 rows above it and if they are the same I want it to delete it. My loops are working. I just can't get this if to work.

mdmackillop
04-20-2007, 08:35 AM
Work with a diminishing i
For i = 1000 to 1 step -1

Djblois
04-20-2007, 08:38 AM
I already am working with a diminishing i:

For i = finalRow To 2 Step -1

Djblois
04-20-2007, 08:41 AM
Here is the full loop:

For i = finalRow To 2 Step -1

If Range("C" & i) = Range("C" & i - 2) Then
Cells(i, "C").EntireRow.Delete

ElseIf Cells(i, "C") = Cells(i - 1, "C") Then

Range("J" & i).Offset(-1, 0).FormulaR1C1 = "=RC[-3]-R[1]C[-3]"
If Abs(Range("J" & i).Offset(-1, 0)) < 0.01 Then Range("J" & i).Offset(-1, 0).ClearContents
Range("J" & i).Offset(-1, 0).Value = Range("J" & i).Offset(-1, 0).Value

Range("K" & i).Offset(-1, 0).FormulaR1C1 = "=(RC[-5]-R[1]C[-5])/7"
If Range("K" & i).Offset(-1, 0) < 1 Then Range("K" & i).Offset(-1, 0).ClearContents
Range("K" & i).Offset(-1, 0).Value = Range("K" & i).Offset(-1, 0).Value

Cells(i, "C").EntireRow.Delete

Else
Range("E" & i) = Format(Date - Range("D" & i) / 7, "dd/mm/yy")
End If

Next

mdmackillop
04-20-2007, 08:51 AM
Can you post a spreadsheet with some data.

Djblois
04-20-2007, 09:35 AM
Here is a spreadsheet with modified code:

I just relized it didn't add because it was too large. I reduced the size and uploaded it now

mdmackillop
04-20-2007, 09:47 AM
No attachment

Djblois
04-20-2007, 10:11 AM
its there now

mdmackillop
04-20-2007, 10:43 AM
Is your data always sorted in Column C as shown?

Djblois
04-20-2007, 10:46 AM
I sort it before I do the rest of the code. I ran the code up to that point and then stopped it and cut the code up from then on. Also, if you can find anything that is can speed it up it would be greatly appreciated. If you can I will name my first born after you! lol

mdmackillop
04-20-2007, 10:52 AM
As I see it, you want to add some fields based on the first two items of each product, then delete the second item; correct?

Djblois
04-20-2007, 11:18 AM
Yes I am trying to get the last price someone paid on items, then how long ago it was, and so on. In the end their should only be one line for each product per customer.

Ex:

Mike butcher Cheese
Mike butcher Meat
Mike butcher Bread
Freds discount Bread
Total food Cheese
Total Food Bread

Also,

I already have it working but it is very slow and I am trying to speed it up. I have cut a lot of time out of most of my reports this is one I can't speed up for some reason.

mdmackillop
04-20-2007, 11:58 AM
Here's a different methodology for clearing duplicate items, retaining the first two in each group. You can modify your formula code to suit this output.
Also, don't replace the formula with the value in each cycle, do it at the end, then delete the unwanted items. You could do this with a filter on the blank cells.


Dim Prods As Range

Sub DelDups()
Dim Prod
Dim Top As Long, Bottom As Long
DoSort
MakeList
For Each Prod In Prods
Top = Columns(3).Find(Prod, after:=Range("C1"), _
searchdirection:=xlNext).Row
Bottom = Columns(3).Find(Prod, after:=Range("C1"), _
searchdirection:=xlPrevious).Row
If Bottom - Top >= 2 Then
Range(Cells(Top + 2, "A"), Cells(Bottom, "H")).Delete xlUp
End If
Next
Columns(14).ClearContents
End Sub

Sub MakeList()
Range("C2:C" & FinalRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"N2"), Unique:=True
Set Prods = Range(Cells(3, "N"), Cells(2, "N").End(xlDown))
End Sub

Sub DoSort()
Range("A2:A" & FinalRow).Resize(, 8).Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("F2") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
End Sub

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

mdmackillop
04-20-2007, 12:23 PM
A formula for column J
=IF(C2=C3,G2-G3,IF(COUNTIF(C:C,C2)=1,"x",""))

Djblois
04-24-2007, 01:42 PM
That all worked perfectly