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

Romano_odK

Active Member
Joined
Jun 4, 2020
Messages
380
Office Version
  1. 365
Platform
  1. Windows
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
ABCDEFGHIJKLMNO
5ArtikelcodeZoekcodeOmschrijvingStatusStartdatumVerkoopprijsVerkoopprijs nieuwVkp + opslagKp +opslagKp +margeEenheidKostprijsKostprijs nieuwIkp +opslag%Afwijking % Opslag
61000008712759037825Vito Glaserfix 111 6x2 mm wit - 10x25 mA24/09/201920,66 pak1,00  -87,615%
71000018712759037832Vito Glaserfix 111 6x2 mm zwart - 10x25 mA24/09/201920,66 pak2,00  -72,231%
81000028712759037849Vito Glaserfix 111 6x3 mm wit - 10x25 mA24/09/201922,96 pak3,00  -60,746%
91000038712759037856Vito Glaserfix 111 6x3 mm zwart - 10x25 mA24/09/201922,96 pak4,00  -46,662%
101000048712759037863Vito Glaserfix 111 6x4 mm wit - 10x25 mA24/09/201930,99 pak5,00  -50,917%
111000058712759037870Vito Glaserfix 111 6x4 mm zwart - 10x25 mA24/09/201930,99 pak6,00  -40,500%
121000068712759037917Vito Glaserfix 111 9x2 mm wit - 10x25 mA24/09/201927,94 pak4,00  -49,667%
131000078712759037924Vito Glaserfix 111 9x2 mm zwart - 10x25 mA24/09/201927,94 pak5,00  -36,333%
141000088712759037955Vito Glaserfix 111 9x3 mm wit - 10x25 mA24/09/201930,61 pak4,00  -54,807%
151000098712759037962Vito Glaserfix 111 9x3 mm zwart - 10x25 mA24/09/201930,61 pak5,00  -42,759%
161000108712759035500Vito Glaserfix 111 9x4 mm wit - 10x25 mA24/09/201935,21 pak4,00  -60,895%
171000118712759038341Vito Glaserfix 111 9x4 mm zwart - 10x25 mA24/09/201935,21 pak6,00  -39,842%
181000128712759037993Vito Glaserfix 111 9x5 mm wit - 10x10 mA24/09/201918,22 pak5,46  ok
191000138712759038006Vito Glaserfix 111 9x5 mm zwart - 10x10 mA24/09/201918,22 pak5,46  ok
Items
Cell Formulas
RangeFormula
M6:M19M6=IFERROR(IFS(N6>0,AN6*(1*N6)+AN6)/AU6,"")
N6:N19N6=IFERROR(IFS(J6>0,L6/(1-J6),I6>0,L6*(1*I6)+L6,H6>0,F6*(1*H6)+F6),"")
O6:O19O6=IFERROR(IFS(ROUND((((P6*$O$2)+P6)-L6),2)=0,"ok",P6<>0,(100%-((L6*AU6/P6)))*-100%-$O$2),"")
G6:G19G6=IFERROR(IFS(J6>0,L6/(1-J6),I6>0,L6*(1*I6)+L6,H6>0,F6*(1*H6)+F6),"")
Cells with Conditional Formatting
CellConditionCell FormatStop If True
O6:O10205Cell Value="ok"textNO
O6:O10205Cell Valuecontains "inkoopprijs"textNO
C6:C10205Expression=LEN(C6)>60textNO
B6:B10205Cell ValueduplicatestextNO
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
untested but should do the job

VBA Code:
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
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0
Solution
Thanks. Give this a try with a copy of your workbook. Check table and column names.

VBA Code:
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?
 
Upvote 0
Blanks are no problem, assuming you mean blanks in that same column. Just add the blue code in this line

Rich (BB code):
If LCase(a(i, 1)) = "ok" Or Len(a(i, 1)) = 0 Then
 
Upvote 0
Blanks are no problem, assuming you mean blanks in that same column. Just add the blue code in this line

Rich (BB code):
If LCase(a(i, 1)) = "ok" Or Len(a(i, 1)) = 0 Then
Thank you that also works as predicted.
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,198
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top