Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 557
Default DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO

Hi all, I have data in sheet (see below)

ROW A E F-----col
1 3080 G16 11
2 500 G16 12
3 -3080 G16 11
4 3080 G16 11
5 -3080 G16 11
6 -3080 G16 12
7 5040 G34 11
8 52590 G34 12
9 -5040 G34 11
10 5040 G34 11
11 -5040 G34 11
12 -5040 G34 12

I want macro which should check values in column E and F in row by row
like E1 & F1 and if E1 & F1 value match in any other row of column E
and F like in above table I have G16 and 11 in cell E1 & F1 and excect
value in cell E3 & F3 and so on. So when same row value in column E
and F match and in the same row of where those value matching if they
have debit and criedit amount in column A then both debit and credit
figures rows should be deleted. i hope that i have explained what i
am trying to say. Please if any friend can help.

Macro should bring result like this (see below)

ROW A E F-----col
1 500 G16 12
2 -3080 G16 12
3 52590 G34 12
4 -5040 G34 12
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 77
Default DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO

Here's some code to start you off;

Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
For Each C In ActiveSheet.Range("H6:H17") 'change this range
C.Select
If Left(C.Value, 1) = "-" Then
FINDC = "+" & C.Value
Else
FINDC = "-" & C.Value
End If
C1 = C.Offset(0, 1).Value
C2 = C.Offset(0, 2).Value

With ActiveSheet.Cells
Set FOUNDCELL = ActiveSheet.Range("H6:H17").FIND(FINDC, ,
xlValues) 'change this range
End With
If Not FOUNDCELL Is Nothing Then
FOUNDCELL.Activate
If FOUNDCELL.Offset(0, 1).Value = C1 Then
If FOUNDCELL.Offset(0, 2).Value = C2 Then
FOUNDCELL.Value = "DUPLICATE" & I
C.Value = "DUPLICATE" & J
Else
'DO NOTHING
End If
End If
End If
I = I + 1
J = J + 1
Next C
Dim RNG As Range
For J = 6 To 17 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then
RNG.EntireRow.Delete
J = J - 1
Else
End If
Next J
End Sub

Here's what you need to do;

Put the code in the worksheet object where your values are. Change the
ranges in the code - in this example I have used the range H6:H17 as
the first column in your table - in your example above it would be A1
to A12. I have marked in the code where you need to change the ranges
to suit your worksheet.

Run the code. It checks for a match and if it finds a match it marks
it as DUPLICATE. Then when it has found all of the DUPLICATES it
deletes these rows. I have tested it and it works perfectly for me.
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 557
Default DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO

On Apr 22, 12:47*pm, anon wrote:
Here's some code to start you off;

Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
For Each C In ActiveSheet.Range("H6:H17") 'change this range
C.Select
If Left(C.Value, 1) = "-" Then
FINDC = "+" & C.Value
Else
FINDC = "-" & C.Value
End If
C1 = C.Offset(0, 1).Value
C2 = C.Offset(0, 2).Value

With ActiveSheet.Cells
* * * Set FOUNDCELL = ActiveSheet.Range("H6:H17").FIND(FINDC, ,
xlValues) 'change this range
* * *End With
* * *If Not FOUNDCELL Is Nothing Then
* * * FOUNDCELL.Activate
* * * If FOUNDCELL.Offset(0, 1).Value = C1 Then
* * * If FOUNDCELL.Offset(0, 2).Value = C2 Then
* * * FOUNDCELL.Value = "DUPLICATE" & I
* * * C.Value = "DUPLICATE" & J
* * * Else
* * * 'DO NOTHING
* * * End If
* * * End If
* * * End If
I = I + 1
J = J + 1
Next C
Dim RNG As Range
For J = 6 To 17 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then
RNG.EntireRow.Delete
J = J - 1
Else
End If
Next J
End Sub

Here's what you need to do;

Put the code in the worksheet object where your values are. Change the
ranges in the code - in this example I have used the range H6:H17 as
the first column in your table - in your example above it would be A1
to A12. I have marked in the code where you need to change the ranges
to suit your worksheet.

Run the code. It checks for a match and if it finds a match it marks
it as DUPLICATE. Then when it has found all of the DUPLICATES it
deletes these rows. I have tested it and it works perfectly for me.


hi anon thank for replying. I checked your macro and it works fine
but it slightly giving different result on the sheet the one I got. I
already have macro in my sheet (please see below). It works fine but
as you can see that it only match value from column E and then delete
DR and CR figures from column A. but i want it look value in column F
as well as i explained in my question above. is it possible that you
can do some amendments in macro below and then it should check value
from column E & F and then delete DR and CR figures. as this macro
gives exact result what i want but just need to add column F which i
have no clue how i'll do it.

Sub DELDRCR()
HdgRow = 5
i1 = Cells(Rows.Count, "E").End(xlUp).Row
While i1 = HdgRow + 2
j1 = 1
While i1 - j1 HdgRow And Cells(i1, "E").Value = Cells(i1 -
j1, "E").Value
If -Cells(i1, "A") = Cells(i1 - j1, "A") _
And IsNumeric(Cells(i1, "D")) Then
Rows(i1).DELETE
Rows(i1 - j1).DELETE
i1 = i1 - 2
j1 = 0
End If
j1 = j1 + 1
Wend
i1 = i1 - 1
Wend
End Sub
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 77
Default DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO

The code I gave you checks columns E & F (if you've changed the ranges
to suit your sheet as i explained).

Basically my code finds the match in the first column, then checks the
next two columns. If they all match the rows will get deleted.

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 557
Default DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO

On Apr 22, 4:43*pm, anon wrote:
The code I gave you checks columns E & F (if you've changed the ranges
to suit your sheet as i explained).

Basically my code finds the match in the first column, then checks the
next two columns. If they all match the rows will get deleted.


Hi anon I just have few questions about your code so I can better
understand how it works. Can you please give me little bit
explaination if you don’t mind

1 - "I = 1" what this recommend
2 - "J = 500" what this recommend
3 - "For Each C In ActiveSheet.Range("H6:H17") " how can I change
this range to H6 to the last value cell in column H
4 - "C1 = C.Offset(0, 1).Value" which column this code is
recommending I or J
5 - "C2 = C.Offset(0, 2).Value" which column this code is
recommending J or K
6 - For J = 6 To 17 how can I change this row change from 6 to last
value cell row in column H


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 77
Default DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO

Hi,

1 & 2. Both I & J are just there to mark the cells Duplicate 1,
Duplicate 2, Duplicate 500 etc before they are deleted. They are not
column letters.

3. To change this you need to replace the one line with these lines;

Dim toend As Long
toend = Range("H" & Rows.Count).End(xlUp).Row
For Each C In ActiveSheet.Range("H6:H" & toend)

4. C1 = C.Offset(0, 1).Value
This is checking the column one row to the right of H and storing
the value (column I)

5. C2 = C.Offset(0, 2).Value
This is checking the column two rows to the right of H and storing the
value (column J)

6. For J = 6 To 17
If you have added in the code described above in step 3 just change
this line to
For J = 6 to toend

So your code will look like this (I have added explanations)

Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
Dim toend As Long
toend = Range("H" & Rows.Count).End(xlUp).Row 'find the last row
in column H and store it as toend
For Each C In ActiveSheet.Range("H6:H" & toend) ' for each cell (C) in
H6 to the last used row in column H
C.Select 'select the cell
If Left(C.Value, 1) = "-" Then 'check if the value of the cell is a
minus number
FINDC = "+" & C.Value 'if it is a minus number set FINDC (ie. the
value to search for) as a poitive number
Else 'if it is not a minus number
FINDC = "-" & C.Value 'set FINDC (ie. the value to search for) as a
minus number
End If
C1 = C.Offset(0, 1).Value 'set C1 as the value of the cell in the same
row in column I
C2 = C.Offset(0, 2).Value 'set C1 as the value of the cell in the same
row in column J


With ActiveSheet.Cells
Set FOUNDCELL = ActiveSheet.Range("H6:H" & toend).FIND(FINDC, ,
xlValues) 'FOUNDCELL is what we're looking for
End With
If Not FOUNDCELL Is Nothing Then 'if the matching value is cound
in column H
FOUNDCELL.Activate 'activate the cell where it is found
If FOUNDCELL.Offset(0, 1).Value = C1 Then 'check the cell in
column I matched the column I on the row we are searching from
If FOUNDCELL.Offset(0, 2).Value = C2 Then 'check the cell in
column J matched the column I on the row we are searching from
FOUNDCELL.Value = "DUPLICATE" & I 'if all 3 cells match set the
cell value as DUPLICATE and a number (eg. DUPLICATE1)
C.Value = "DUPLICATE" & J 'if all 3 cells match set the original
cell value as DUPLICATE and a number (eg. DUPLICATE500)

Else
'DO NOTHING
End If
End If
End If
I = I + 1
J = J + 1
Next C 'do this for all of the cell values in column H
Dim RNG As Range
For J = 6 To toend 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
'search through H6 to the ast cell in column H
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then 'if the left of the cell
value is duplicate
RNG.EntireRow.Delete 'delete the row
J = J - 1 'now check the row above (as we have just deleted a row)
Else
End If
Next J
End Sub

Shout if you have any more questions.

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 557
Default DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO

On 26 Apr, 12:28, anon wrote:
Hi,

1 & 2. Both I & J are just there to mark the cells Duplicate 1,
Duplicate 2, Duplicate 500 etc before they are deleted. They are not
column letters.

3. To change this you need to replace the one line with these lines;

Dim toend As Long
* * toend = Range("H" & Rows.Count).End(xlUp).Row
* *For Each C In ActiveSheet.Range("H6:H" & toend)

4. C1 = C.Offset(0, 1).Value
* *This is checking the column one row to the right of H and storing
the value (column I)

5. C2 = C.Offset(0, 2).Value
This is checking the column two rows to the right of H and storing the
value (column J)

6. For J = 6 To 17
If you have added in the code described above in step 3 just change
this line to
For J = 6 to toend

So your code will look like this (I have added explanations)

Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
Dim toend As Long
* * toend = Range("H" & Rows.Count).End(xlUp).Row *'find the last row
in column H and store it as toend
For Each C In ActiveSheet.Range("H6:H" & toend) ' for each cell (C) in
H6 to the last used row in column H
C.Select 'select the cell
If Left(C.Value, 1) = "-" Then *'check if the value of the cell is a
minus number
FINDC = "+" & C.Value *'if it is a minus number set FINDC (ie. the
value to search for) as a poitive number
Else *'if it is not a minus number
FINDC = "-" & C.Value 'set FINDC (ie. the value to search for) as a
minus number
End If
C1 = C.Offset(0, 1).Value 'set C1 as the value of the cell in the same
row in column I
C2 = C.Offset(0, 2).Value 'set C1 as the value of the cell in the same
row in column J

With ActiveSheet.Cells
* * * Set FOUNDCELL = ActiveSheet.Range("H6:H" & toend).FIND(FINDC, ,
xlValues) 'FOUNDCELL is what we're looking for
* * *End With
* * *If Not FOUNDCELL Is Nothing Then 'if the matching value is cound
in column H
* * * FOUNDCELL.Activate 'activate the cell where it is found
* * * If FOUNDCELL.Offset(0, 1).Value = C1 Then 'check the cell in
column I matched the column I on the row we are searching from
* * * If FOUNDCELL.Offset(0, 2).Value = C2 Then *'check the cell in
column J matched the column I on the row we are searching from
* * * FOUNDCELL.Value = "DUPLICATE" & I *'if all 3 cells match set the
cell value as DUPLICATE and a number (eg. DUPLICATE1)
* * * C.Value = "DUPLICATE" & J 'if all 3 cells match set the original
cell value as DUPLICATE and a number (eg. DUPLICATE500)

* * * Else
* * * 'DO NOTHING
* * * End If
* * * End If
* * * End If
I = I + 1
J = J + 1
Next C 'do this for all of the cell values in column H
Dim RNG As Range
For J = 6 To toend 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
'search through H6 to the ast cell in column H
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then 'if the left of the cell
value is duplicate
RNG.EntireRow.Delete 'delete the row
J = J - 1 'now check the row above (as we have just deleted a row)
Else
End If
Next J
End Sub

Shout if you have any more questions.


Thanks anon thats brilliant. just another small question that i tried
your code and it work superb but for some reason its still leaving few
dr and cr figures which need to be deleted. As in my Sheet some time
same values in column E and F have dr figure in A1 and the cr figure
come in A50 so may be both dr and cr figures are too far from
eachother that macro not picking them and macro just deleting the dr
cr figures which are bit near to eachother. i know you may be
thinking that i should sort data first and then run macro but you see
i cant do this as this will ruin my whole spreadsheet. is their way
you can solve this for me. Many thanks
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default reg the code

Can any one help me plz!!!!

i have a sheet with 10 columns and 20 rows.
For eg say from A to k columns and 1 to 20 rows of data.
if a value matches in column G i.e G2=25 and G5=-25 then i need to copy and paste both the row G2 and G5 in another sheet of same workbook

Please help me on this



anon wrote:

Hi,1 & 2.
27-Apr-08

Hi,

1 & 2. Both I & J are just there to mark the cells Duplicate 1,
Duplicate 2, Duplicate 500 etc before they are deleted. They are not
column letters.

3. To change this you need to replace the one line with these lines;

Dim toend As Long
toend = Range("H" & Rows.Count).End(xlUp).Row
For Each C In ActiveSheet.Range("H6:H" & toend)

4. C1 = C.Offset(0, 1).Value
This is checking the column one row to the right of H and storing
the value (column I)

5. C2 = C.Offset(0, 2).Value
This is checking the column two rows to the right of H and storing the
value (column J)

6. For J = 6 To 17
If you have added in the code described above in step 3 just change
this line to
For J = 6 to toend

So your code will look like this (I have added explanations)

Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
Dim toend As Long
toend = Range("H" & Rows.Count).End(xlUp).Row 'find the last row
in column H and store it as toend
For Each C In ActiveSheet.Range("H6:H" & toend) ' for each cell (C) in
H6 to the last used row in column H
C.Select 'select the cell
If Left(C.Value, 1) = "-" Then 'check if the value of the cell is a
minus number
FINDC = "+" & C.Value 'if it is a minus number set FINDC (ie. the
value to search for) as a poitive number
Else 'if it is not a minus number
FINDC = "-" & C.Value 'set FINDC (ie. the value to search for) as a
minus number
End If
C1 = C.Offset(0, 1).Value 'set C1 as the value of the cell in the same
row in column I
C2 = C.Offset(0, 2).Value 'set C1 as the value of the cell in the same
row in column J


With ActiveSheet.Cells
Set FOUNDCELL = ActiveSheet.Range("H6:H" & toend).FIND(FINDC, ,
xlValues) 'FOUNDCELL is what we're looking for
End With
If Not FOUNDCELL Is Nothing Then 'if the matching value is cound
in column H
FOUNDCELL.Activate 'activate the cell where it is found
If FOUNDCELL.Offset(0, 1).Value = C1 Then 'check the cell in
column I matched the column I on the row we are searching from
If FOUNDCELL.Offset(0, 2).Value = C2 Then 'check the cell in
column J matched the column I on the row we are searching from
FOUNDCELL.Value = "DUPLICATE" & I 'if all 3 cells match set the
cell value as DUPLICATE and a number (eg. DUPLICATE1)
C.Value = "DUPLICATE" & J 'if all 3 cells match set the original
cell value as DUPLICATE and a number (eg. DUPLICATE500)

Else
'DO NOTHING
End If
End If
End If
I = I + 1
J = J + 1
Next C 'do this for all of the cell values in column H
Dim RNG As Range
For J = 6 To toend 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
'search through H6 to the ast cell in column H
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then 'if the left of the cell
value is duplicate
RNG.EntireRow.Delete 'delete the row
J = J - 1 'now check the row above (as we have just deleted a row)
Else
End If
Next J
End Sub

Shout if you have any more questions.

Previous Posts In This Thread:

On Wednesday, April 23, 2008 8:27 PM
K wrote:

DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO
Hi all, I have data in sheet (see below)

ROW A E F-----col
1 3080 G16 11
2 500 G16 12
3 -3080 G16 11
4 3080 G16 11
5 -3080 G16 11
6 -3080 G16 12
7 5040 G34 11
8 52590 G34 12
9 -5040 G34 11
10 5040 G34 11
11 -5040 G34 11
12 -5040 G34 12

I want macro which should check values in column E and F in row by row
like E1 & F1 and if E1 & F1 value match in any other row of column E
and F like in above table I have G16 and 11 in cell E1 & F1 and excect
value in cell E3 & F3 and so on. So when same row value in column E
and F match and in the same row of where those value matching if they
have debit and criedit amount in column A then both debit and credit
figures rows should be deleted. i hope that i have explained what i
am trying to say. Please if any friend can help.

Macro should bring result like this (see below)

ROW A E F-----col
1 500 G16 12
2 -3080 G16 12
3 52590 G34 12
4 -5040 G34 12

On Wednesday, April 23, 2008 8:27 PM
anon wrote:

Here's some code to start you off;Sub FINDANDDELETE()Dim C, FINDC, C1, C2,
Here's some code to start you off;

Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
For Each C In ActiveSheet.Range("H6:H17") 'change this range
C.Select
If Left(C.Value, 1) = "-" Then
FINDC = "+" & C.Value
Else
FINDC = "-" & C.Value
End If
C1 = C.Offset(0, 1).Value
C2 = C.Offset(0, 2).Value

With ActiveSheet.Cells
Set FOUNDCELL = ActiveSheet.Range("H6:H17").FIND(FINDC, ,
xlValues) 'change this range
End With
If Not FOUNDCELL Is Nothing Then
FOUNDCELL.Activate
If FOUNDCELL.Offset(0, 1).Value = C1 Then
If FOUNDCELL.Offset(0, 2).Value = C2 Then
FOUNDCELL.Value = "DUPLICATE" & I
C.Value = "DUPLICATE" & J
Else
'DO NOTHING
End If
End If
End If
I = I + 1
J = J + 1
Next C
Dim RNG As Range
For J = 6 To 17 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then
RNG.EntireRow.Delete
J = J - 1
Else
End If
Next J
End Sub

Here's what you need to do;

Put the code in the worksheet object where your values are. Change the
ranges in the code - in this example I have used the range H6:H17 as
the first column in your table - in your example above it would be A1
to A12. I have marked in the code where you need to change the ranges
to suit your worksheet.

Run the code. It checks for a match and if it finds a match it marks
it as DUPLICATE. Then when it has found all of the DUPLICATES it
deletes these rows. I have tested it and it works perfectly for me.

On Wednesday, April 23, 2008 8:28 PM
K wrote:

DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO
On Apr 22, 12:47=A0pm, anon wrote:

hi anon thank for replying. I checked your macro and it works fine
but it slightly giving different result on the sheet the one I got. I
already have macro in my sheet (please see below). It works fine but
as you can see that it only match value from column E and then delete
DR and CR figures from column A. but i want it look value in column F
as well as i explained in my question above. is it possible that you
can do some amendments in macro below and then it should check value
from column E & F and then delete DR and CR figures. as this macro
gives exact result what i want but just need to add column F which i
have no clue how i'll do it.

Sub DELDRCR()
HdgRow =3D 5
i1 =3D Cells(Rows.Count, "E").End(xlUp).Row
While i1 =3D HdgRow + 2
j1 =3D 1
While i1 - j1 HdgRow And Cells(i1, "E").Value =3D Cells(i1 -
j1, "E").Value
If -Cells(i1, "A") =3D Cells(i1 - j1, "A") _
And IsNumeric(Cells(i1, "D")) Then
Rows(i1).DELETE
Rows(i1 - j1).DELETE
i1 =3D i1 - 2
j1 =3D 0
End If
j1 =3D j1 + 1
Wend
i1 =3D i1 - 1
Wend
End Sub

On Wednesday, April 23, 2008 8:28 PM
anon wrote:

The code I gave you checks columns E & F (if you've changed the rangesto suit
The code I gave you checks columns E & F (if you've changed the ranges
to suit your sheet as i explained).

Basically my code finds the match in the first column, then checks the
next two columns. If they all match the rows will get deleted.

On Saturday, April 26, 2008 1:51 AM
K wrote:

DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO
On Apr 22, 4:43=A0pm, anon wrote:

Hi anon I just have few questions about your code so I can better
understand how it works. Can you please give me little bit
explaination if you don=92t mind

1 - "I =3D 1" what this recommend
2 - "J =3D 500" what this recommend
3 - "For Each C In ActiveSheet.Range("H6:H17") " how can I change
this range to H6 to the last value cell in column H
4 - "C1 =3D C.Offset(0, 1).Value" which column this code is
recommending I or J
5 - "C2 =3D C.Offset(0, 2).Value" which column this code is
recommending J or K
6 - For J =3D 6 To 17 how can I change this row change from 6 to last
value cell row in column H

On Sunday, April 27, 2008 12:06 PM
anon wrote:

Hi,1 & 2.
Hi,

1 & 2. Both I & J are just there to mark the cells Duplicate 1,
Duplicate 2, Duplicate 500 etc before they are deleted. They are not
column letters.

3. To change this you need to replace the one line with these lines;

Dim toend As Long
toend = Range("H" & Rows.Count).End(xlUp).Row
For Each C In ActiveSheet.Range("H6:H" & toend)

4. C1 = C.Offset(0, 1).Value
This is checking the column one row to the right of H and storing
the value (column I)

5. C2 = C.Offset(0, 2).Value
This is checking the column two rows to the right of H and storing the
value (column J)

6. For J = 6 To 17
If you have added in the code described above in step 3 just change
this line to
For J = 6 to toend

So your code will look like this (I have added explanations)

Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
Dim toend As Long
toend = Range("H" & Rows.Count).End(xlUp).Row 'find the last row
in column H and store it as toend
For Each C In ActiveSheet.Range("H6:H" & toend) ' for each cell (C) in
H6 to the last used row in column H
C.Select 'select the cell
If Left(C.Value, 1) = "-" Then 'check if the value of the cell is a
minus number
FINDC = "+" & C.Value 'if it is a minus number set FINDC (ie. the
value to search for) as a poitive number
Else 'if it is not a minus number
FINDC = "-" & C.Value 'set FINDC (ie. the value to search for) as a
minus number
End If
C1 = C.Offset(0, 1).Value 'set C1 as the value of the cell in the same
row in column I
C2 = C.Offset(0, 2).Value 'set C1 as the value of the cell in the same
row in column J


With ActiveSheet.Cells
Set FOUNDCELL = ActiveSheet.Range("H6:H" & toend).FIND(FINDC, ,
xlValues) 'FOUNDCELL is what we're looking for
End With
If Not FOUNDCELL Is Nothing Then 'if the matching value is cound
in column H
FOUNDCELL.Activate 'activate the cell where it is found
If FOUNDCELL.Offset(0, 1).Value = C1 Then 'check the cell in
column I matched the column I on the row we are searching from
If FOUNDCELL.Offset(0, 2).Value = C2 Then 'check the cell in
column J matched the column I on the row we are searching from
FOUNDCELL.Value = "DUPLICATE" & I 'if all 3 cells match set the
cell value as DUPLICATE and a number (eg. DUPLICATE1)
C.Value = "DUPLICATE" & J 'if all 3 cells match set the original
cell value as DUPLICATE and a number (eg. DUPLICATE500)

Else
'DO NOTHING
End If
End If
End If
I = I + 1
J = J + 1
Next C 'do this for all of the cell values in column H
Dim RNG As Range
For J = 6 To toend 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
'search through H6 to the ast cell in column H
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then 'if the left of the cell
value is duplicate
RNG.EntireRow.Delete 'delete the row
J = J - 1 'now check the row above (as we have just deleted a row)
Else
End If
Next J
End Sub

Shout if you have any more questions.

On Sunday, April 27, 2008 12:06 PM
K wrote:

DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO
On 26 Apr, 12:28, anon wrote:
row
, ,
d

in
et the
inal

Thanks anon thats brilliant. just another small question that i tried
your code and it work superb but for some reason its still leaving few
dr and cr figures which need to be deleted. As in my Sheet some time
same values in column E and F have dr figure in A1 and the cr figure
come in A50 so may be both dr and cr figures are too far from
eachother that macro not picking them and macro just deleting the dr
cr figures which are bit near to eachother. i know you may be
thinking that i should sort data first and then run macro but you see
i cant do this as this will ruin my whole spreadsheet. is their way
you can solve this for me. Many thanks


Submitted via EggHeadCafe - Software Developer Portal of Choice
ASP.NET AJAX Automatically Saving Web Form Data
http://www.eggheadcafe.com/tutorials...omaticall.aspx
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
MACRO FOR DELETING DEBIT AND CREDIT FIGURES ROWS K[_2_] Excel Programming 1 February 5th 08 05:10 PM
how do i set up a debit and credit formula on the worksheet Ruth Blackwell Excel Worksheet Functions 2 January 1st 08 03:34 PM
Debit/credit amount Slection How? Qazi Ahmad Excel Discussion (Misc queries) 1 January 11th 07 06:07 AM
Credit and Debit formating Tim Excel Discussion (Misc queries) 0 May 1st 05 09:26 PM


All times are GMT +1. The time now is 11:58 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"