Problem with macro

[Jeeremy7]

Hello,

I have a macro running but i think some informations are in double so the macro doesn't work..
If somoene could help it would be really nice

Here's the code

    lr = Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 1 Step -1
        If (Cells(r, "B") Like "") Then
            If Rng Is Nothing Then Set Rng = Rows(r) Else Set Rng = Union(Rng, Rows(r))
        End If

    lr = Cells(Rows.Count, "A").End(xlUp).Row
        If Not (Cells(r, 1) Like "##-####") Then
            If Rng Is Nothing Then Set Rng = Rows(r) Else Set Rng = Union(Rng, Rows(r))
        End If
    Next r
    If Not Rng Is Nothing Then Rng.Delete
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True

Thanks !

 

[Fluff]

What should be left afterwards?

 

[Jeeremy7]

What should be left afterwards?

Just this information

Copy of Copy of TEMPLATE - Lump Sum Direct cost.xlsm
	A	B
1	01-0102	3835
2	01-0121	495
3	01-0137	57.58
4	01-5201	5
5	02-7403	425
6	06-1101	125.84
7	08-1101	1743
Direct Cost

 

[Fluff]

Ok, try

lr = Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        If Cells(r, "B") = "" Then
            If Rng Is Nothing Then Set Rng = Rows(r) Else Set Rng = Union(Rng, Rows(r))
        End If
       
        If IsError(Cells(r, 1)) Then
            If Rng Is Nothing Then Set Rng = Rows(r) Else Set Rng = Union(Rng, Rows(r))
        ElseIf Not Cells(r, 1) Like "##-####" Then
            If Rng Is Nothing Then Set Rng = Rows(r) Else Set Rng = Union(Rng, Rows(r))
        End If
    Next r
    If Not Rng Is Nothing Then Rng.Delete

 

[Jeeremy7]

Almost perfect
I just have a value that stayed i'm not sure why (row1)

Copy of Copy of TEMPLATE - Lump Sum Direct cost.xlsm
	A	B	C
1	-	Amount P.O	.#
2	01-0102	3835
3	01-0121	495
4	01-0137	57.58
5	01-5201	5
6	02-7403	425
7	06-1101	125.84
8	08-1101	1743
9	08-1102	303.75
10	08-7002	149.11
11	09-2003	13900
12	09-6503	11100
13	09-9103	4600
14	21-1303	1294.44
15	23-3003	11314
16	26-6003	9658.6
Direct Cost

 

[Jeeremy7]

It's ok I pulled differents data and this row always stays I'll just create a .delete for A

Thanks a lot for you help Fluff it's not the first time and it's always answering the question !

 

[Fluff]

I assumed that was a header row & should be left, change this

For r = lr To 1 Step -1

 

[Jeeremy7]

I'm creating a header afterward

Thanks again that solved it

 

[Fluff]

You're welcome & thanks for the feedback.

 

[DanteAmor]

I think it could be simplified a bit like this:

Sub test()
  Dim lr As Long, r As Long, rng As Range
  lr = Cells(Rows.Count, "A").End(xlUp).Row
  Set rng = Rows(lr + 1)
  For r = lr To 1 Step -1
    If IsError(Cells(r, 1)) Then
      Set rng = Union(rng, Rows(r))
    ElseIf Cells(r, "B") = "" Or IsError(Cells(r, 1)) Or Not Cells(r, 1) Like "##-####" Then
      Set rng = Union(rng, Rows(r))
    End If
  Next r
  rng.Delete
End Sub

 

[Jeeremy7]

I think it could be simplified a bit like this:

Sub test()
  Dim lr As Long, r As Long, rng As Range
  lr = Cells(Rows.Count, "A").End(xlUp).Row
  Set rng = Rows(lr + 1)
  For r = lr To 1 Step -1
    If IsError(Cells(r, 1)) Then
      Set rng = Union(rng, Rows(r))
    ElseIf Cells(r, "B") = "" Or IsError(Cells(r, 1)) Or Not Cells(r, 1) Like "##-####" Then
      Set rng = Union(rng, Rows(r))
    End If
  Next r
  rng.Delete
End Sub

That's working too thanks !