Delete entire row if cell equals with a cell's value

Question

I have a VBA code in Excel with an issue. I ask the user to give a number (which is actually a week's number). This data is going to set for range Q1. I have converted the dates (which are already in the sheet) to the column "K" to the weeks number with the formula "Weeknum". Now I want to keep only those rows which are equal with the user's entry that is shown in the cell "Q1".

Now the result is that the sheet shows the weeknum only as values not as formulas, but nothing has been deleted.

range("K6").FormulaR1C1 = "=WEEKNUM(RC[-10])"
range("K6").Select
Selection.AutoFill Destination:=range("K6:K65536")
    
range("K6:K65536").Copy
range("K6:K65536").PasteSpecial xlPasteValues

Dim Valid3 As Boolean
Dim Data3 As String

While Valid3 = False
    het = InputBox("Kérlek, add meg melyik hétre szűrjek rá!", "További szűrés beállítása", "")
    If IsNumeric(het) Then
            Valid3 = True
            range("Q1").Value = het
        Else
            Valid3 = False
            MsgBox "HIBA! Valószínűleg rossz formátumban adtad meg a szűrendő hetet."
    End If
Wend

    Dim Rng3 As range
    Dim x3 As Long
    Set Rng3 = range("K6:K" & range("K65536").End(xlUp).Row)
    For x3 = Rng3.Rows.Count To 1 Step -1
        If InStr(1, Rng3.Cells(x3, 1).Value, range("Q1")) = 0 Then
            Rng3.Cells(x3, 1).EntireRow.Delete
        End If
    Next x3

Answer 1

Column K only contains a number, the week number, so you don't need anything as complicated as

InStr(1, Rng3.Cells(x3, 1).Value, range("Q1"))

I'd do it like this:

Set Rng3 = range("K6")
Do while not Rng3 = ""
  If Rng3.value = het then
    Set Rng3 = Rng3.Offset(1,0)
    Rng3.Offset(-1,0).EntireRow.Delete
  Else
    Set Rng3 = Rng3.Offset(1,0)
  End if
Loop

Note that deleting individual rows is slow and if you have a lot of data might become painfully slow.

There is an alternative method which will be much quicker:

• filter column K on value does not equal het
• goto special, visible cells only
• clear active cells
• remove filter

Answer 2

You may try something like this...

Sub DeleteRows()
Dim i As Long, lr As Long, het As Long
Dim Valid3 As Boolean
Dim Rng As Range

Application.ScreenUpdating = False

lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("K6:K" & lr).Formula = "=WEEKNUM(A6)"
Range("K6:K" & lr).Value = Range("K6:K" & lr).Value

While Valid3 = False
    het = InputBox("Kérlek, add meg melyik hétre szurjek rá!", "További szurés beállítása", "")
    If IsNumeric(het) Then
            Valid3 = True
            Range("Q1").Value = het
        Else
            Valid3 = False
            MsgBox "HIBA! Valószínuleg rossz formátumban adtad meg a szurendo hetet."
    End If
Wend

For i = lr To 6 Step -1
     If Cells(i, "K") <> het Then
        If Rng Is Nothing Then
            Set Rng = Cells(i, "K")
        Else
            Set Rng = Union(Rng, Cells(i, "K"))
        End If
     End If
Next i

If Not Rng Is Nothing Then Rng.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Answer 3

Thanks the answer to both of you. Unfortunately these solutions still not solve the problem. Now I copy the entire code for you, hopefully you might see what I can't. :) Now I insert the original code, that not contains your solutions.

The interesting fact is that I ask the user to give 3 datas. All the datas are asked the same way, and for the first two run the code works perfect, but the third one.

    Sub SzponzorSzűrő()

Dim Valid As Boolean
Dim Data As String

While Valid = False
        csatorna = InputBox("Kérlek, add meg a szűrendő csatorna nevét!", "Szűrendő csatorna", "")
        If Not IsNumeric(csatorna) Then
                Valid = True
                range("Q1").Value = csatorna
        Else
                Valid = False
                MsgBox "HIBA! Valószínűleg rosszul adtad meg a szűrendő csatorna nevét."
    End If
Wend

    Dim rng As range
    Dim X As Long
    Set rng = range("D6:D" & range("D65536").End(xlUp).Row)
    For X = rng.Rows.Count To 1 Step -1
        If InStr(1, rng.Cells(X, 1).Value, range("Q1")) = 0 Then
                rng.Cells(X, 1).EntireRow.Delete
        End If
    Next X
range("Q1").Delete

valasztas = MsgBox("Szeretnéd, hogy tovább szűrjem a listát egy adott hétre?", vbYesNo + vbQuestion, "További szűrési lehetőségek")
If valasztas = vbYes Then

Dim Valid2 As Boolean
Dim Data2 As String

While Valid2 = False
        datum = InputBox("Kérlek, add meg hogy melyik évre szűrjek rá!", "További szűrés beállítása", "")
        If IsNumeric(datum) Then
            Valid2 = True
            range("Q1").Value = datum
            Else
            Valid2 = False
                MsgBox "HIBA! Valószínűleg rossz formátumban adtad meg a szűrendő évet."
        End If
    Wend

Dim Rng2 As range
    Dim x2 As Long
    Set Rng2 = range("A6:A" & range("A65536").End(xlUp).Row)
 For x2 = Rng2.Rows.Count To 1 Step -1
     If InStr(1, Rng2.Cells(x2, 1).Value, range("Q1")) = 0 Then
        Rng2.Cells(x2, 1).EntireRow.Delete
    End If
Next x2
range("Q1").Delete

range("K6").FormulaR1C1 = "=WEEKNUM(RC[-10])"
range("K6").Select
Selection.AutoFill Destination:=range("K6:K65536")

range("K6:K65536").Copy
range("K6:K65536").PasteSpecial xlPasteValues

Dim Valid3 As Boolean
Dim Data3 As String

While Valid3 = False
het = InputBox("Kérlek, add meg melyik hétre szűrjek rá!", "További szűrés beállítása", "")
If IsNumeric(het) Then
        Valid3 = True
        range("Q1").Value = het
    Else
        Valid3 = False
        MsgBox "HIBA! Valószínűleg rossz formátumban adtad meg a szűrendő hetet."
End If
Wend

Dim Rng3 As range
Dim x3 As Long
Set Rng3 = range("K6:K" & range("K65536").End(xlUp).Row)
For x3 = Rng3.Rows.Count To 1 Step -1
    If InStr(1, Rng3.Cells(x3, 1).Value, range("Q1")) = 0 Then
        Rng3.Cells(x3, 1).EntireRow.Delete
    End If
Next x3

MsgBox ("A szponzorok leszűrve egy adott csatornára és egy megadott hétre.")
Else
MsgBox ("A szponzorok leszűrve egy adott csatornára.")
End If

End Sub