How to remove al line with VBA when the values is "OK"

[Romano_odK]

Good morning,
With the push of a button I like to remove the lines with the value "ok" in column O. Can this be done?

Thank you for your time.

Artikelen beheren XML 5.05.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
5	Artikelcode	Zoekcode	Omschrijving	Status	Startdatum	Verkoopprijs	Verkoopprijs nieuw	Vkp + opslag	Kp +opslag	Kp +marge	Eenheid	Kostprijs	Kostprijs nieuw	Ikp +opslag%	Afwijking % Opslag
6	100000	8712759037825	Vito Glaserfix 111 6x2 mm wit - 10x25 m	A	24/09/2019	20,66					pak	1,00			-87,615%
7	100001	8712759037832	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	A	24/09/2019	20,66					pak	2,00			-72,231%
8	100002	8712759037849	Vito Glaserfix 111 6x3 mm wit - 10x25 m	A	24/09/2019	22,96					pak	3,00			-60,746%
9	100003	8712759037856	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	A	24/09/2019	22,96					pak	4,00			-46,662%
10	100004	8712759037863	Vito Glaserfix 111 6x4 mm wit - 10x25 m	A	24/09/2019	30,99					pak	5,00			-50,917%
11	100005	8712759037870	Vito Glaserfix 111 6x4 mm zwart - 10x25 m	A	24/09/2019	30,99					pak	6,00			-40,500%
12	100006	8712759037917	Vito Glaserfix 111 9x2 mm wit - 10x25 m	A	24/09/2019	27,94					pak	4,00			-49,667%
13	100007	8712759037924	Vito Glaserfix 111 9x2 mm zwart - 10x25 m	A	24/09/2019	27,94					pak	5,00			-36,333%
14	100008	8712759037955	Vito Glaserfix 111 9x3 mm wit - 10x25 m	A	24/09/2019	30,61					pak	4,00			-54,807%
15	100009	8712759037962	Vito Glaserfix 111 9x3 mm zwart - 10x25 m	A	24/09/2019	30,61					pak	5,00			-42,759%
16	100010	8712759035500	Vito Glaserfix 111 9x4 mm wit - 10x25 m	A	24/09/2019	35,21					pak	4,00			-60,895%
17	100011	8712759038341	Vito Glaserfix 111 9x4 mm zwart - 10x25 m	A	24/09/2019	35,21					pak	6,00			-39,842%
18	100012	8712759037993	Vito Glaserfix 111 9x5 mm wit - 10x10 m	A	24/09/2019	18,22					pak	5,46			ok
19	100013	8712759038006	Vito Glaserfix 111 9x5 mm zwart - 10x10 m	A	24/09/2019	18,22					pak	5,46			ok
Items

Cell Formulas
Range	Formula
M6:M19	M6	=IFERROR(IFS(N6>0,AN6*(1*N6)+AN6)/AU6,"")
N6:N19	N6	=IFERROR(IFS(J6>0,L6/(1-J6),I6>0,L6*(1*I6)+L6,H6>0,F6*(1*H6)+F6),"")
O6:O19	O6	=IFERROR(IFS(ROUND((((P6*$O$2)+P6)-L6),2)=0,"ok",P6<>0,(100%-((L6*AU6/P6)))*-100%-$O$2),"")
G6:G19	G6	=IFERROR(IFS(J6>0,L6/(1-J6),I6>0,L6*(1*I6)+L6,H6>0,F6*(1*H6)+F6),"")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
O6:O10205	Cell Value	="ok"	text	NO
O6:O10205	Cell Value	contains "inkoopprijs"	text	NO
C6:C10205	Expression	=LEN(C6)>60	text	NO
B6:B10205	Cell Value	duplicates	text	NO

 

[Kerryx]

untested but should do the job

Sub Delete_Rows
Dim cell As Range
For Each cell In Range("O6:O10205")
    ' Delete rows containing "ok"
    If cell.Value = "ok" Then
        cell.EntireRow.Delete
    End If
Next cell
End Sub

 

[Peter_SSs]

You have shown to row 19, but about how many rows of data altogether are you likely to be dealing with before any are deleted?

 

[Peter_SSs]

untested but should do the job

Not sure if you were unable to test or just didn't because it seemed simple, but you should if possible as that code won't do the job reliably.

 

[Romano_odK]

You have shown to row 19, but about how many rows of data altogether are you likely to be dealing with before any are deleted?

Should be around 10.000 in a table called ItemsImport.

 

[Peter_SSs]

Should be around 10.000 in a table called ItemsImport.

Thanks. Give this a try with a copy of your workbook. Check table and column names.

Sub Del_ok()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Range("ItemsImport").Columns.Count + 1
  a = Range("ItemsImport[[#All],[Afwijking %" & Chr(10) & "Opslag]]").Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If LCase(a(i, 1)) = "ok" Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("ItemsImport[#All]").Resize(, nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
      .Offset(1).Resize(k).EntireRow.Delete
      .Columns(nc).EntireColumn.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[Romano_odK]

Thanks. Give this a try with a copy of your workbook. Check table and column names.

Sub Del_ok()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Range("ItemsImport").Columns.Count + 1
  a = Range("ItemsImport[[#All],[Afwijking %" & Chr(10) & "Opslag]]").Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If LCase(a(i, 1)) = "ok" Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("ItemsImport[#All]").Resize(, nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
      .Offset(1).Resize(k).EntireRow.Delete
      .Columns(nc).EntireColumn.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

Thank you this works like a charm. Say that I would want to also delete lines where there are blanks in a cell, would that be possible too or are blanks a problem?

 

[Peter_SSs]

Blanks are no problem, assuming you mean blanks in that same column. Just add the blue code in this line

If LCase(a(i, 1)) = "ok" Or Len(a(i, 1)) = 0 Then

 

[Romano_odK]

Blanks are no problem, assuming you mean blanks in that same column. Just add the blue code in this line

If LCase(a(i, 1)) = "ok" Or Len(a(i, 1)) = 0 Then

Thank you that also works as predicted.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.