I need an update to this code (Which I copied from an answer on a post here) that could only delete rows that have :01 and :31.

hmourad

New Member
Joined
Jun 12, 2020
Messages
14
Office Version
  1. 2010
Platform
  1. Windows
VBA Code:
Sub Del_Non_00()
  Dim a, b
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range("B1", Range("B" & rows.count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If Right(Format(a(i, 1), "hh:mm"), 3) <> ":31" Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
 
End Sub

So here instead of "Del_non_00" I basically want it to "Del_01_31", if you know what I mean..

I tried changing
If Right(Format(a(i, 1), "hh:mm"), 3) <> ":31" Then
b(i, 1) = 1
k = k - 1 'changed from + to -
End If
If k > 0 Then changed from < to >
and it just brings these rows to the bottom of the list but doesn't delete them.. and also gives me "Runtime error "1004" (Application -defined or object -defined error) for this code: .Resize(k).EntireRow.Delete

There's also another condition where sometimes I have :01 and :31 values that I need only when the following row is also :01 or :31, so I need to delete :01 or :31 only under the condition that it is not followed by another :01 or :31..

In the attached screenshot it could be clearer..
 

Attachments

  • 01rows.JPG
    01rows.JPG
    133.1 KB · Views: 31
:unsure: These two statements are contradictory as my code deletes row 23 from that sample data. :confused:
No it doesn’t delete row 23, it keeps both 22 and 23, I tried it and made sure of it.. I’ll double check again tonight.. but for now it works good.
 
Upvote 0

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
No it doesn’t delete row 23
In that case there is something different about your data and my data.

Rich (BB code):
    If Minute(a(i, 1)) = 1 Or Minute(a(i, 1)) = 31 Then
      If Minute(a(i + 1, 1)) <> 1 And Minute(a(i + 1, 1)) <> 31 Then
This part of my code says
If the minute value in row 23 is 1 or 31 (which it is) then
If the minute part of row 24 is not 1 and it is not 31 (which is true because the minute part of that row is 35) then
delete row 23

Can you post that sample data, or some other small sample data with XL2BB so that I can be sure I am testing with the same data as you? If my code is retaining row 23 in that sample data then it could be treating other rows incorrectly too.
 
Upvote 0
Okay I double checked and it turns out you were right, it does delete 23, I got you some data but different values from the screenshot, I edited it to have some of the conditions that occur, for example a row with :01 followed by another one with :01 and a row with :31 followed by another one with :31 (These are the examples of the ones I don't want removed from the sheet), the condition which I want removed from the sheet automatically is when a row with :31 is neither followed by a :31 nor does it have a previous row with :31, same for :01.

Here's the data you were asking for:

Untitled.csv
ABCDEFGHIJKLMN
46########19:36:00UH opened valves no. [14 and 16] and bled-off pressure.71:06:00########
47########19:01:0071:09:00########31.773.218.12419.123.238.4
48########19:39:00UH closed valves no. [14 and 16].71:09:00########
49########19:01:0071:10:00########81.273.315.955.620.223.1105.6
50########19:01:00UH turned off PORT side burner boom pilot.71:10:00########
51########19:42:0071:12:00########214.573.516.8134.819.423.1222.6
52########19:42:00Aljassra flushed lines.71:12:00########
53########19:31:0071:19:00########108.373.915.275.11823.4115.2
54########19:31:00Aljassra closed valve no. [7].71:19:00########
55########20:00:0071:30:00########90.774.116.854.918.92397.1
56########20:30:0072:00:00########90.273.716.654.819.923.296.8
57########21:00:0072:30:00########89.573.615.365.720.123.196.4
58########21:30:0073:00:00########89.573.216.454.81923.296
59########22:00:0073:30:00########89.272.616.555.619.323.495.7
60########22:01:00Slickline commenced rig down.73:30:00########
61########22:01:0073:31:00########89.272.815.764.620.12395.8
62########22:30:0074:00:00########89.272.615.264.419.723.295.6
63########23:00:0074:30:00########89.272.515.864.519.922.995.4
64########23:01:0074:50:00########88.872.31664.519.623.395.5
65########23:20:00Slickline completed rig down.74:50:00########
Untitled
 
Upvote 0
Here's the data you were asking for:
Thanks.

It looks to me that for that data, rows 47 and 64 should be the only ones deleted?

Try this version. In the above sample, the first data row is row 46. If that is not the case with your real data, just edit the 'Const' line near the start of the code.

VBA Code:
Sub Del_01_31_v2()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, m As Long
 
  Const FirstDataRow As Long = 46 '<- Edit if required

  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("B" & FirstDataRow, Range("B" & Rows.Count).End(xlUp).Offset(1)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a) - 1
    m = Minute(a(i, 1))
    If m = 1 Or m = 31 Then
      If Minute(a(i + 1, 1)) <> m And Minute(a(i - 1, 1)) <> m Then
        b(i, 1) = 1
        k = k + 1
      End If
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A" & FirstDataRow).Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
 
Upvote 0
Yes man
Thanks.

It looks to me that for that data, rows 47 and 64 should be the only ones deleted?

Try this version. In the above sample, the first data row is row 46. If that is not the case with your real data, just edit the 'Const' line near the start of the code.

VBA Code:
Sub Del_01_31_v2()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, m As Long

  Const FirstDataRow As Long = 46 '<- Edit if required

  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("B" & FirstDataRow, Range("B" & Rows.Count).End(xlUp).Offset(1)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a) - 1
    m = Minute(a(i, 1))
    If m = 1 Or m = 31 Then
      If Minute(a(i + 1, 1)) <> m And Minute(a(i - 1, 1)) <> m Then
        b(i, 1) = 1
        k = k + 1
      End If
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A" & FirstDataRow).Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
this works very well now, I just adjusted the first row in the code and it works good, really appreciate your help, learning a whole lot! Will definitely recommend this website to anyone asking for Excel help.
 
Upvote 0
Cheers. Glad you have found the forum useful. Thanks for the follow-up. :)
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

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