Do while with IF

[Barbu]

Hi,

I need to do a couple of do whiles with an IF that validate if a cell it's equal to a number (locations codes) then delete the entire row, (I need them in 2 different macros)
And the issue is that I have 90 locations codes (for now) So, how can I create this kind of "database" as simple as it could be and make it part of my code

I.e. some locations codes are: CA1405, CE8574, MN7891, RC1020, PR5471, LK6871 ... etc.

That's what I have.

        Allrows = Range("A" & Rows.Count).End(xlUp).row
 
    Dim fila As Integer
        fila = 2
    Do While (fila <= Allrows)
        rango1 = "D" & CStr(fila)
        Allrows = Range("A" & Rows.Count).End(xlUp).row
        If (Range(rango1) = [COLOR=seagreen]"Locations codes"[/COLOR]) Then
        Rows(fila).Select
        Selection.Delete Shift:=xlUp
        fila = fila - 1
        End If
        fila = fila + 1
    Loop

Thank you very much !!! any help will be very apreciate.

 

[p45cal]

untested:

Sub blah
CodesToLose="CA1405, CE8574, MN7891, RC1020, PR5471, LK6871"
Allrows = Range("A" & Rows.Count).End(xlUp).row
For i = Allrows to 2 step -1
   if instr(CodesToLose,cells(i,"D"))>0 then rows(i).delete
next i
End sub

 

[tigeravatar]

Alternate version:

Sub tgr()
    
    With Intersect(ActiveSheet.UsedRange, Range("A:D"))
        .AutoFilter 1, Array("CE8574", "LK6871", "MN7891", "PR5471", "RC1020"), xlFilterValues
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
    
End Sub

 

[Barbu]

Hi guys, thank you very much for your replies, and sorry I didn't answer before, but I was on vacations

I think I didn't explain it very well last time, what I need it's like declare the codes ("CE8574", "LK6871", "MN7891", "PR5471", "RC1020") in other module (like a public Dim, or something like that) because I need to used them in several macros and I don't want to type them every time.

also I need to know how use this kind of public Dim in your codes !!!

thank you so much for your help !!!

 

[tigeravatar]

Barbu,

Put this in a standard module (for now, I'm assuming this is going in Module1) to use and assign values to a public variable:

Public CodesToDelete As Variant
 
Sub Assign_CodesToDelete()
 
    CodesToDelete = Array("CA1405", "CE8574", "MN7891", "RC1020", "PR5471", "LK6871")
 
End Sub

Then, you just call the Assign_CodesToDelete from any macro that uses that variable in order to populate it, and then you can use the CodesToDelete array:

Sub tgr()
 
    Call Module1.Assign_CodesToDelete
 
    With Intersect(ActiveSheet.UsedRange, Range("A:D"))
        .AutoFilter 4, Module1.CodesToDelete, xlFilterValues
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
 
End Sub

 

[p45cal]

In the declarations portion (= top) of any standard code module:

Public Const CodesToLose As String = "CA1405, CE8574, MN7891, RC1020, PR5471, LK6871"

then remove the equivalent line from the macro, leaving:

Sub blah()
Allrows = Range("A" & Rows.Count).End(xlUp).row
For i = Allrows to 2 step -1
   if instr(CodesToLose,cells(i,"D"))>0 then rows(i).delete
next i
End sub

 

[Barbu]

I'm sorry guys, but I tested both codes, and I got a type mismatch error every time.

Thank you very much for your help !!!

 

[tigeravatar]

Barbu,

Both codes provided should work. What is the code you're actually running and what line is giving the error?

 

[p45cal]

I'm sorry guys, but I tested both codes, and I got a type mismatch error every time.

Thank you very much for your help !!!

on what line did you get the error on mine?
I've just tested mine - it deleted more lines than I wanted (blanks in column D as well) so a tweak to one of the lines:

   If InStr(CodesToLose, Cells(i, "D")) > 0 And Len(Cells(i, "D").Value) > 0 Then Rows(i).Delete

and to prevent rows with cells in column D with just a single space in from being deleted, you could remove the spaces from the line in the declaration area to leave:

Public Const CodesToLose As String = "CA1405,CE8574,MN7891,RC1020,PR5471,LK6871"

 

[Barbu]

Tigeravatar,

I got a Run-time error '1004': AutoFilter Method of Range class failed, in this line

Sub tgr()
 
    Call Module2.Assign_CodesToDelete
 
    With Intersect(ActiveSheet.UsedRange, Range("A:D"))
        [B][COLOR=darkred].AutoFilter 4, Module2.CodesToDelete, xlFilterValues[/COLOR][/B]
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
 
End Sub

And this is what I have in the other module:

Public CodesToDelete As Variant
 
Sub Assign_CodesToDelete()
CodesToDelete = Array("80186", "80205", "80320", "80321", "80340", "80343", "80344", "80363", "80366", "80539")
End Sub