?
Solved

remove rows between two values in a column

Posted on 2011-09-08
8
Medium Priority
?
278 Views
Last Modified: 2012-05-12
Hi
I'm working on some macros for a spreadsheet but am having a hardtime coming up with a way to hide or delete extra data via code.
The scenario is this - In column K there is either a 1 or a 0, 1 indicates the start of a process, 0 the end.
so the column can look like the below (i.e. multiple proceses start and stop)
I want to find the first 1 then the 0 and delete the rows in bettween, then find the next 1 and next 0 and delete the rows in between and so on
1
1 -Delete
1 -Delete
1 -Delete
0
0 -Delete
0 -Delete
1
1 -Delete
1 -Delete
0
0 -Delete
0 -Delete
1
1 -Delete
0
0
Comment
Question by:kwatt562
8 Comments
 
LVL 14

Expert Comment

by:JP
ID: 36504370
Try the attached code.
Sub cleanup()
Application.ScreenUpdating = False
Dim lastrow As Long
lastrow = [k65536].End(xlUp).Row
For i = lastrow To 2 Step -1 'Change the "to 2" to "to 1" if you do not have headers!
    If Cells(i - 1, "k").Value = Cells(i, "k").Value Then
    Rows(i).Delete (xlUp)
    End If
Next i
End Sub

Open in new window

0
 
LVL 5

Expert Comment

by:slycoder
ID: 36504408
Mine works very similar:


Public Sub DeleteItems()

    ' Turn off screen updates for speed
    Application.ScreenUpdating = False

    ' Change this to be the last row
    ' Position Cursor at end of range
    Range("K16").Select
   
    'Loop till at the top - again you can change this if you have headers
    Do While ActiveCell.Row > 1
   
        ' check previous cell
        If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
       
            ' delete current row
            Selection.EntireRow.Delete
        End If
       
        ' Move cursor up
        ActiveCell.Offset(-1, 0).Select
    Loop
   
    ' Turn on screen updates
    Application.ScreenUpdating = True
   
End Sub
0
 
LVL 35

Expert Comment

by:Rob Henson
ID: 36509224
Would this logic apply?

If the value of the cell above is the same as the current row, the current row can be deleted.

If so this can be done with formula and then just apply a filter to this new column.

Assuming data starts in K1, formula in L2:

=IF(K2=K1,"Delete","")

Apply AutoFilter on column K and filter for Delete. Select visible cells with mouse or cursor keys but not whole column, delete rows, warning message about deleting entire row, OK.

This is what Slycoder's routine is doing but in code one row at a time. Might be quicker to apply filter and delete in one hit.

Thanks
Rob H
0
Free tool for managing users' photos in Office 365

Easily upload multiple users’ photos to Office 365. Manage them with an intuitive GUI and use handy built-in cropping and resizing options. Link photos with users based on Azure AD attributes. Free tool!

 

Author Comment

by:kwatt562
ID: 36509523
Thanks a lot, all great suggestions/solutions
I wonder if you could help with a scenario i just encountered with one particular worksheet
it relates to first 0 (end point) not being the actual end point in the process
is there a way to set the end point in the process to be the first 0 (in column K) that has the maximum numeric value in column p
so
colK           colP
1
1 -delete
1 -delete
0 -delete          
0 -delete   400
0                600
1
1 -delete
etc
0
 
LVL 14

Expert Comment

by:JP
ID: 36510098
Try the attached code.
Sub cleanup()
Application.ScreenUpdating = False
Dim lastrow As Long
lastrow = [k65536].End(xlUp).Row
For i = lastrow To 2 Step -1 'Change the "to 2" to "to 1" if you do not have headers!
    If Cells(i - 1, "k").Value = Cells(i, "k").Value Then
        If Cells(i - 1, "p").Value > Cells(i, "p").Value Then
            Rows(i).Delete (xlUp)
        Else
            Rows(i - 1).Delete (xlUp)
            GoTo continue
        End If
    Rows(i).Delete (xlUp)
    End If
continue:
Next i
End Sub

Open in new window

0
 

Author Comment

by:kwatt562
ID: 36510763
Hi thanks for that, doesnt quite work out, but I'm probably not explaining myself well enough
I attach an example report (this is a simplied version without all the other macros on it.
Highlighted in red is the start of each process (number 1 column K), the end of the process is highlighted in blue (last number 0 in column K,with highest value in column P - In the case that the values are the same, then it should be the last value)
So once the macro runs there should only 4 rows remaining below the header
1 red (start),1 blue (end) then 1 red(start) ,1 (end) blue (obviously in other examples there may be more processes)


test.xls
0
 
LVL 14

Accepted Solution

by:
JP earned 2000 total points
ID: 36511708
Sorry you were right there was some misunderstanding. The attached code worked for me with your sample file.
Sub cleanup()
Application.ScreenUpdating = False
Dim lastrow As Long
lastrow = [k65536].End(xlUp).Row
For i = lastrow To 8 Step -1 'Change the "to 8" to "to #" top row with data to be evaluated
    Select Case Cells(i, "k").Value
        Case 0
            If Cells(i - 1, "k").Value = Cells(i, "k").Value Then
                If Cells(i - 1, "p").Value <= Cells(i, "p").Value Then
                    Rows(i - 1).Delete (xlUp)
                    GoTo continue
                Else
                    Rows(i).Delete (xlUp)
                    GoTo continue
                End If
            End If
        Case 1
            If Cells(i - 1, "k").Value = Cells(i, "k").Value Then
                    Rows(i).Delete (xlUp)
                    GoTo continue
            End If
    End Select
continue:
Next i
End Sub

Open in new window

0
 

Author Comment

by:kwatt562
ID: 36511745
That works perfectly, thanks a lot!
0

Featured Post

Free tool for managing users' photos in Office 365

Easily upload multiple users’ photos to Office 365. Manage them with an intuitive GUI and use handy built-in cropping and resizing options. Link photos with users based on Azure AD attributes. Free tool!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There can be many situations demanding the conversion of Outlook OST files to PST format and as such, there is no shortage of automated tools to perform this conversion. However, what makes Stellar OST to PST converter stand above the rest? Let us e…
Organisation is organized in a pattern to flow the day to day business, every application and system is interdepended on each other and when very important “Exchange Server downtime” happened.
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Is your OST file inaccessible, Need to transfer OST file from one computer to another? Want to convert OST file to PST? If the answer to any of the above question is yes, then look no further. With the help of Stellar OST to PST Converter, you can e…
Suggested Courses

600 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question