How to filter out the rows that are having different values in the columns

[Romano_odK]

Good morning,

In the attached sheet I would like to be able to filter out the rows that do not have a different value in both column C and D. So I like to keep the row that have a different value in C and D and delete the rest. I also have a piece of code which was genouely given to me to delete filtered rows. Maybe it would be possible to alter this. Could anyone help me with this please.

Thank you for your time.

Romano

Onderhoud prijzen 9.4.15Beta.xlsm
	A	B	C	D	E
7	100000	Item number 1	19,13	20,28	6,00%
8	100001	Item number 2	19,13	19,13
9	100002	Item number 3	21,26	23,17	9,00%
10	100003	Item number 4	21,26	21,90	3,00%
11	100004	Item number 5	28,69	30,41	6,00%
12	100005	Item number 6	28,69	28,69
13	100006	Item number 7	25,87	25,87
14	100007	Item number 8	25,87	25,87
OPXML

Cell Formulas
Range	Formula
D7:D14	D7	=IFERROR(IFS(H7>0,K7/(1-H7),G7>0,K7*G7+K7,F7>0,F7,E7>0,E7*AL7+AL7,$D$1>0,$D$1*AM7+AM7,C7<>AM7,C7,C7=AM7,AM7),"")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C7:C14	Cell Value	<>$AL7	text	NO

Private Sub VerwijderVerborgenRijen_Click()

Application.EnableEvents = False
  Application.ScreenUpdating = False
  With ActiveSheet.ListObjects(1)
    .ListColumns.Add Position:=2
    On Error Resume Next
    .ListColumns(2).DataBodyRange.SpecialCells(xlVisible).Value = 1
    On Error GoTo 0
    If .Parent.FilterMode Then .Parent.ShowAllData
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=.ListColumns(2).DataBodyRange, SortOn:=xlSortOnValues, Order:=xlAscending
    .Sort.Apply
    On Error Resume Next
    .ListColumns(2).DataBodyRange.SpecialCells(xlBlanks).EntireRow.Delete
    On Error GoTo 0
    .ListColumns(2).Delete
  End With
  Application.EnableEvents = False

Range("AJ7:AJ15000").ClearContents
Range("AK7:AK15000").ClearContents
Range("AL7:AL15000").ClearContents

  With Sheets("OPXML").ListObjects("Table_Query_from_A100")
      .ListColumns(36).DataBodyRange.Value = .ListColumns(3).DataBodyRange.Value
   End With
    With Sheets("OPXML").ListObjects("Table_Query_from_A100")
      .ListColumns(37).DataBodyRange.Value = .ListColumns(11).DataBodyRange.Value
   End With
    With Sheets("OPXML").ListObjects("Table_Query_from_A100")
      .ListColumns(38).DataBodyRange.Value = .ListColumns(16).DataBodyRange.Value
   End With


    Dim xAF As AutoFilter
    Dim xFs As Filters
    Dim xLos As ListObjects
    Dim xLo As ListObject
    Dim xRg As Range
    Dim xWs As Worksheet
    Dim xIntC, xF1, xF2, xCount As Integer
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each xWs In Application.Worksheets
        xWs.ShowAllData
        Set xLos = xWs.ListObjects
        xCount = xLos.Count
        For xF1 = 1 To xCount
         Set xLo = xLos.Item(xF1)
         Set xRg = xLo.Range
         xIntC = xRg.Columns.Count
         For xF2 = 1 To xIntC
            xLo.Range.AutoFilter Field:=xF2
           
         Next
        Next
    Next
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    
  

End Sub

 

[Peter_SSs]

Not quite sure where your range is to start or end but you could test something like this.

Sub DelSame()
  With Range("C7", Range("C" & Rows.Count).End(xlUp))
    .Value = Evaluate(Replace("if(#=" & .Offset(, 1).Address & ",True,#)", "#", .Address))
    On Error Resume Next
    .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
  End With
End Sub

 

[Romano_odK]

Not quite sure where your range is to start or end but you could test something like this.

Sub DelSame()
  With Range("C7", Range("C" & Rows.Count).End(xlUp))
    .Value = Evaluate(Replace("if(#=" & .Offset(, 1).Address & ",True,#)", "#", .Address))
    On Error Resume Next
    .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
  End With
End Sub

Hi Peter,
Thank you for replying. I indeed didn't say on which row I wanted to start or end. Its actually a table and it starts on row 7 until, well the end of it which is diferent every time.

What I get with your code is the value TRUE and the rows with the same values Re not deleted. Like this:

Onderhoud prijzen 9.4.16Beta.xlsm
	A	B	C	D	E
6	Artikelcode	Omschrijving	Verkoopprijs	Verkoopprijs nieuw	Vkp % opslag
7	100000	Vito Glaserfix 111 6x2 mm wit - 10x25 m	TRUE	TRUE
8	100001	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	19,13	20,27	6,00%
9	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	TRUE	TRUE
10	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	TRUE	TRUE
11	100004	Vito Glaserfix 111 6x4 mm wit - 10x25 m	TRUE	TRUE
12	100005	Vito Glaserfix 111 6x4 mm zwart - 10x25 m	TRUE	TRUE
13	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	25,87	27,42	6,00%
OPXML

Cell Formulas
Range	Formula
D7:D13	D7	=IFERROR(IFS(H7>0,K7/(1-H7),G7>0,K7*G7+K7,F7>0,F7,E7>0,E7*AL7+AL7,$D$1>0,$D$1*AM7+AM7,C7<>AM7,C7,C7=AM7,AM7),"")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C7:C9797	Cell Value	<>$AL7	text	NO

 

[Peter_SSs]

Try this then, checking the table name.

Sub DelSame_v2()
  With Range("Table1[Verkoopprijs]")
    .Value = Evaluate(Replace("if(#=" & .Offset(, 1).Address & ",True,#)", "#", .Address))
  End With
  With Range("Table1[#All]")
    .AutoFilter Field:=3, Criteria1:="TRUE"
    If .Columns(1).SpecialCells(xlVisible).Count > 1 Then .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
    .AutoFilter Field:=3
  End With
End Sub

 

[Romano_odK]

Try this then, checking the table name.

Sub DelSame_v2()
  With Range("Table1[Verkoopprijs]")
    .Value = Evaluate(Replace("if(#=" & .Offset(, 1).Address & ",True,#)", "#", .Address))
  End With
  With Range("Table1[#All]")
    .AutoFilter Field:=3, Criteria1:="TRUE"
    If .Columns(1).SpecialCells(xlVisible).Count > 1 Then .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
    .AutoFilter Field:=3
  End With
End Sub

Now it does not work entirely an that is probably to the cause that there are more column in this sheet and a lot of them turn into "TRUE" and thats a problem, but the lines that need to be deleted are so that works. I also get an error ' Can't move cells in a filtered range or table"

Onderhoud prijzen 9.4.16Beta.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
6	Artikelcode	Omschrijving	Verkoopprijs	Verkoopprijs nieuw	Vkp % opslag	Nieuwe Vkp €	Opslag% [Kp]	Marge% [Kp]	Kp~Vkp% opslag	Kp~Vkp% marge	Kostprijs	Kostprijs nieuw	Kp % opslag	Verschil Kp~Ikp*Kp_f	Kp opslag-Kp_f	Kp_factor	Opslag% Kp~Ikp	Inkoopprijs
7	100000	Item 1	TRUE	19,13	3,00%	TRUE	TRUE	0,0%	217,8%	68,5%	TRUE	6,02	0,00%	-0,18	Kp_factor?	0,00%	3,08%	TRUE
9	100002	Item 2	TRUE	21,26	TRUE	TRUE	TRUE	0,0%	223,6%	69,1%	TRUE	6,57	0,00%	-0,19	Kp_factor?	0,00%	2,98%	TRUE
10	100003	Item 3	TRUE	21,26	TRUE	TRUE	TRUE	0,0%	223,6%	69,1%	TRUE	6,57	0,00%	-0,19	Kp_factor?	0,00%	2,98%	TRUE
11	100004	Item 4	TRUE	28,69	6,00%	TRUE	TRUE	0,0%	218,1%	68,6%	TRUE	9,02	0,00%	-0,26	Kp_factor?	0,00%	2,97%	TRUE
12	100005	Item 5	TRUE	28,69	TRUE	TRUE	TRUE	0,0%	218,1%	68,6%	TRUE	9,02	0,00%	-0,26	Kp_factor?	0,00%	2,97%	TRUE
OPXML

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
O7:O9797	Cell Value	="Inkoopprijs?"	text	NO
O7:O9797	Cell Value	="Kp_factor?"	text	NO
O7:O9797	Cell Value	<-0,1%	text	NO
O7:O9797	Cell Value	>0,1%	text	NO
R7:R9797	Cell Value	<>$AN7	text	NO
C7:C9797	Cell Value	<>$AL7	text	NO
K7:K9797	Cell Value	<>$AM7	text	NO

Private Sub CommandButton1_Click()


With Range("Table_Query_from_A100")
    .Value = Evaluate(Replace("if(#=" & .Offset(, 1).Address & ",True,#)", "#", .Address))
  End With
  With Range("Table_Query_from_A100[#All]")
    .AutoFilter Field:=3, Criteria1:="TRUE"
    If .Columns(1).SpecialCells(xlVisible).Count > 1 Then .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
    .AutoFilter Field:=3
  End With
End Sub

 

[Peter_SSs]

a lot of them turn into "TRUE"

That is because you didn't adapt my code correctly. It should be

With Range("Table_Query_from_A100[Verkoopprijs]")

I also get an error ' Can't move cells in a filtered range or table"

I have not ben able to reproduce that particular error. There must be something else going on in your sheet that I do not have. Are you able to upload a sample file (any sensitive data removed or disguised) that has that error to DropBox/OneDrive/Google Drive etc and provide a shared link here so that it can be investigated further?

 

[Romano_odK]

That is because you didn't adapt my code correctly. It should be

With Range("Table_Query_from_A100[Verkoopprijs]")

I have not ben able to reproduce that particular error. There must be something else going on in your sheet that I do not have. Are you able to upload a sample file (any sensitive data removed or disguised) that has that error to DropBox/OneDrive/Google Drive etc and provide a shared link here so that it can be investigated further?

Hi Peter,
I changed the values according to your suggestion, but I still get an error. A different one, but still an error.

Below here is the file. I stripped it here and there. In column E-H are values that will change the values in column D. So when that happens I need the ones that are not changed to be deleted. In this case row 9 should be gone. I hope you can find the problem as this is the last piece of this project I have been working on for the last few months.

Thank you for your time and have a great day.

Romano

https://kohlerwoodcap-my.sharepoint...dCoDODVO9xbQYBVGY3AABne7WiyE0_IKI4Rg?e=1iG2z0

 

[Peter_SSs]

The link provided is asking me for a sign in. Are you able to provide a link that does not require a sign in?

 

[Romano_odK]

The link provided is asking me for a sign in. Are you able to provide a link that does not require a sign in?

Onderhoud prijzen.xlsm

drive.google.com

 

[Peter_SSs]

Onderhoud prijzen .xlsm

drive.google.com

Hope this works better.

Nope