Deleting decreasing data and naming rows.

[BenSeekingHelp]

I have a list of data in columns B:H that I want to delete specific values
within.
The data in column C is in the format example below. The numbers are not
necessarily whole numbers or increasing or decreasing in even amounts. The
example is simplified as each data set can have thousands of streams where
the data increases then decreases, repeating again and again in a constant
stream. I want a data set of numbers that are continually increasing or
restarting the sequence with no decreasing values or zeros.

Searching column C, when the next cell is < the preceeding cell, select
Rows B:G. Name cell A of selected row "2nd set". Continue selecting rows
B:H until the value in column C is >= 1. Delete and shift up the selected
section. Restart logic starting at row that was named 2nd set.

Format Example: Column C data:
1
3
7
9
7 Name row in cell A "2nd set" and Delete Row B:H and shift row up
3 Delete Row B:H and shift row up
0 Delete Row B:H and shift row up
0 Delete Row B:H and shift row up
1.4
2
3.8
4
2 Name row in cell A "3rd set" and Delete Row B:H and shift row up
0 Delete Row B:H and shift row up
0.1 Delete Row B:H and shift row up
2
6
10
etc.

Huge Thank You! to anyone that can help

 

[OssieMac]

Hi Ben,

I'd like to confirm a couple of things.

You say name cell A of selected row as "2nd Set" etc. Do you mean nameing
the cell as in defined names or simply inserting "2nd set" in the cell in
column A? Also will Set 1, Set 2 suffice because while not impossible, it is
a bit hard to include the suffix to numbers.

Delete Row B:H and shift row up. If you do this then they will be all out of
sync with column A. Do you mean delete the entire row?

 

[OssieMac]

Hi again Ben,

Ensure you have a backup of your workbook before tesing the following code.

I took a punt that you want the labels as values in the cells in column A
and not actually define names for the cells. Not difficult to change if I got
it wrong.

The code actually highlights all of the cells where rows are to be deleted
and I have placed an Exit Sub before the actual rows are deleted. This will
allow you to check what rows are to be deleted and then if I have got it
correct then all you have to do is insert a comment (single quote) at the
start of the line Exit Sub (or delete the code as per the comment) and run
the macro again and the deletion code will be run also.

I prefer the above method when deleting rows because it is the best way I
know of testing that the code is identifying the correct rows to be deleted.

The code accomodates the first set of data to be either incrementing or
decrementing. Also if you have back to back incrementing groups like 2,4,6,8
followed by 3,6,7,9 etc without a decrementing set in between. Don't know if
either of these conditions are likely to occur but I picked it up with some
test data that I created and it had these conditions.

Also note the comments in the code. You may have to edit the worksheet name.

Sub DeleteDecrementingRows()

Dim i As Long
Dim lngStart As Long
Dim lngLastRow As Long
Dim lngCount As Long

'Edit following line to first row of data
'Assumes column headers & starts row 2
lngStart = 2

lngCount = 0 'Initialize

'Edit "Sheet1" to your sheet name
With Sheets("Sheet1")
lngLastRow = .Cells(.Rows.Count, "C") _
.End(xlUp).Row

'Insert label for first group if ascending
If .Cells(lngStart, "C") < _
.Cells(lngStart + 1, "C") Then

lngCount = lngCount + 1
.Cells(lngStart, "A") = "Set " & lngCount
Else
.Cells(lngStart, "C").Interior.ColorIndex = 6
End If

For i = lngStart To lngLastRow
'.Cells(i, "C").Select
'MsgBox .Cells(i, "C")
If .Cells(i + 1, "C") < .Cells(i, "C") Then
'If next cell is start of another incrementing _
group instead of decrementing group
If .Cells(i + 1, "C") < .Cells(i + 2, "C") _
And .Cells(i + 1, "C") >= 1 Then
lngCount = lngCount + 1
.Cells(i + 1, "A") = "Set " & lngCount
GoTo Next_i_Loop
End If

Do
i = i + 1
If i > lngLastRow Then
Exit Do 'Past end of data
End If

.Cells(i, "C").Interior.ColorIndex = 6
Loop While .Cells(i + 1, "C") <= _
.Cells(i, "C") Or _
.Cells(i + 1, "C") < 1

lngCount = lngCount + 1

'Suppress label below actual data
If i + 1 <= lngLastRow Then
.Cells(i + 1, "A") = "Set " & lngCount
End If
End If

Next_i_Loop:
Next i

'*************************************
'Remove the Exit sub and run again
'if you are satisfied that the highlighted
'rows are the correct ones to delete.
Exit Sub
'*************************************

'Must work backwards when deleting rows
For i = lngLastRow To 2 Step -1
If .Cells(i, "C").Interior.ColorIndex = 6 Then
.Cells(i, "C").EntireRow.Delete
End If
Next i

End With

End Sub

 

[BenSeekingHelp]

Hi again Ben,

Ensure you have a backup of your workbook before tesing the following code.

I took a punt that you want the labels as values in the cells in column A
and not actually define names for the cells. Not difficult to change if I got
it wrong.

The code actually highlights all of the cells where rows are to be deleted
and I have placed an Exit Sub before the actual rows are deleted. This will
allow you to check what rows are to be deleted and then if I have got it
correct then all you have to do is insert a comment (single quote) at the
start of the line Exit Sub (or delete the code as per the comment) and run
the macro again and the deletion code will be run also.

I prefer the above method when deleting rows because it is the best way I
know of testing that the code is identifying the correct rows to be deleted.

The code accomodates the first set of data to be either incrementing or
decrementing. Also if you have back to back incrementing groups like 2,4,6,8
followed by 3,6,7,9 etc without a decrementing set in between. Don't know if
either of these conditions are likely to occur but I picked it up with some
test data that I created and it had these conditions.

Also note the comments in the code. You may have to edit the worksheet name.

Sub DeleteDecrementingRows()

Dim i As Long
Dim lngStart As Long
Dim lngLastRow As Long
Dim lngCount As Long

'Edit following line to first row of data
'Assumes column headers & starts row 2
lngStart = 2

lngCount = 0 'Initialize

'Edit "Sheet1" to your sheet name
With Sheets("Sheet1")
lngLastRow = .Cells(.Rows.Count, "C") _
.End(xlUp).Row

'Insert label for first group if ascending
If .Cells(lngStart, "C") < _
.Cells(lngStart + 1, "C") Then

lngCount = lngCount + 1
.Cells(lngStart, "A") = "Set " & lngCount
Else
.Cells(lngStart, "C").Interior.ColorIndex = 6
End If

For i = lngStart To lngLastRow
'.Cells(i, "C").Select
'MsgBox .Cells(i, "C")
If .Cells(i + 1, "C") < .Cells(i, "C") Then
'If next cell is start of another incrementing _
group instead of decrementing group
If .Cells(i + 1, "C") < .Cells(i + 2, "C") _
And .Cells(i + 1, "C") >= 1 Then
lngCount = lngCount + 1
.Cells(i + 1, "A") = "Set " & lngCount
GoTo Next_i_Loop
End If

Do
i = i + 1
If i > lngLastRow Then
Exit Do 'Past end of data
End If

.Cells(i, "C").Interior.ColorIndex = 6
Loop While .Cells(i + 1, "C") <= _
.Cells(i, "C") Or _
.Cells(i + 1, "C") < 1

lngCount = lngCount + 1

'Suppress label below actual data
If i + 1 <= lngLastRow Then
.Cells(i + 1, "A") = "Set " & lngCount
End If
End If

Next_i_Loop:
Next i

'*************************************
'Remove the Exit sub and run again
'if you are satisfied that the highlighted
'rows are the correct ones to delete.
Exit Sub
'*************************************

'Must work backwards when deleting rows
For i = lngLastRow To 2 Step -1
If .Cells(i, "C").Interior.ColorIndex = 6 Then
.Cells(i, "C").EntireRow.Delete
End If
Next i

End With

End Sub



--
Regards,

OssieMac

Ossie,

A huge thank you for the help. Sorry to not get back sooner I have been
testing and editing it, but it works great.

I have some additional deletes I would like to make. can you help me?

1) Rather than selecting and deleting entire rows as the code does I would
like to select and delete the data in rows A:H only at the specified
intervals.
2) I would also like to select and delete some of the "Sets". Just like #1
I want to delete rows A:H of say set 3 up to but not including set 4 and set
6 up to but not including set 7.
3) I have multiple groups of data like the one we wrote for. The next group
is J:Q where the data to be evaluated is in column L, and then S:Z with the
data in column U. I would like to reapeat the above code for 8 of these like
groupings.

Thank you again
Ben

 

[OssieMac]

Hi again Ben,

I am sure we can do what you want. Am I correct in assuming that all groups
of data across the worksheet have 8 columns and the 3rd column is where you
want to delete the rows?

How do you want to tell the system which column the particular data set
starts? My suggestion is an input box that asks you to select the first
column of the set to start processing.

I see that you also have another thread relating to this project and it is
starting to look like an extended project. If you want to get yourself a
Hotmail address (or any other provider of email addresses) that you can
abandon later if you start getting spam and post that address then I will
reply and you can then communicate with an attached copy of your workbook.

If you post an email address then do it something like the following example
so that people using code to troll the internet for email addresses are not
so likely to pick it up but I will be able to decipher it.

myaddress with provider hotmail and then the usual com

 

[OssieMac]

Hi again Ben,

Original code changed so that it only deletes 8 columns of data. There is an
InputBox where you will have to select any cell in the column with the
incrementing/decrementing data to tell the code which set of data to work
with.

To make it easier to code your second part, I have also changed the labels
so they have a fixed number of digits like Set 01, Set 02 etc. See the
comments where you can change the number of digits and make it 3 digits or 4
digits if you like.

The second sub is for deleting specific sets of data. It has 3 InputBoxes:
The first InputBox to select the column with the Set labels.
The second InputBox to enter the number of the first label set to delete.
The third InputBox to enter the last number of the labels sets to delete.

Note when entering the number of the labels to delete, you only enter a
number like 8. Does not require the leading zeros.

If only deleting one set say Set 05 then just enter 5 for the first one and
5 for the last one.

As I did previously, the code is set to color the rows to delete. When you
are satisfied that it is identifying the correct rows, remove the comment
(single quote) from the Exit sub line.

Following is replacement for previous code.

Sub DeleteDecrementingRows()

Dim lngCol As Long
Dim i As Long
Dim lngStart As Long
Dim lngLastRow As Long
Dim lngCount As Long
Dim strFormat As String

'Edit following line to first row of data
'Assumes column headers & starts row 2
lngStart = 2

'*********************************************
'Edit the following line to the number of _
digits required in the Set label _
NOTE: Zeros not aplha characters
strFormat = "00"
'*********************************************

lngCount = 0 'Initialize

On Error Resume Next
lngCol = Application.InputBox _
(Prompt:="Select the column with the" & _
vbLf & "Incrementing/Decrementing data", _
Title:="Data Select", Type:=8).Column

If Err.Number > 0 Then
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If
On Error GoTo 0 'Reset error trapping

'Edit "Sheet1" to your sheet name
With Sheets("Sheet1")
lngLastRow = .Cells(.Rows.Count, lngCol) _
.End(xlUp).Row

'Insert label for first group if ascending
If .Cells(lngStart, lngCol) < _
.Cells(lngStart + 1, lngCol) Then

lngCount = lngCount + 1

.Cells(i + 2, lngCol - 2) = "Set " _
& Format(lngCount, strFormat)
Else
.Cells(lngStart, lngCol) _
.Interior.ColorIndex = 6
End If

For i = lngStart To lngLastRow

If .Cells(i + 1, lngCol) < .Cells(i, lngCol) Then
'If next cell is start of another incrementing _
group instead of decrementing group
If .Cells(i + 1, lngCol) < .Cells(i + 2, lngCol) _
And .Cells(i + 1, lngCol) >= 1 Then
lngCount = lngCount + 1

.Cells(i + 1, lngCol - 2) = "Set " _
& Format(lngCount, strFormat)
GoTo Next_i_Loop
End If

Do
i = i + 1
If i > lngLastRow Then
Exit Do 'Past end of data
End If

.Range(.Cells(i, lngCol - 2), _
.Cells(i, lngCol + 5)) _
.Interior.ColorIndex = 6

Loop While .Cells(i + 1, lngCol) <= _
.Cells(i, lngCol) Or _
.Cells(i + 1, lngCol) < 1

lngCount = lngCount + 1

'Suppress label below actual data
If i + 1 <= lngLastRow Then

.Cells(i + 1, lngCol - 2) = "Set " _
& Format(lngCount, strFormat)
End If
End If

Next_i_Loop:
Next i

'*************************************
'Remove the Exit sub and run again
'if you are satisfied that the highlighted
'rows are the correct ones to delete.
Exit Sub
'*************************************

'Must work backwards when deleting rows
For i = lngLastRow To 2 Step -1
If .Cells(i, lngCol).Interior.ColorIndex = 6 Then
.Range(.Cells(i, lngCol - 2), _
.Cells(i, lngCol + 5)).Delete
End If
Next i

End With

End Sub


Following is new code to delete specifiec sets of data.

Sub DeleteDataSets()
Dim lngCol As Long
Dim lngLastRow As Long
Dim varSet1 As Variant
Dim varSet2 As Variant
Dim strFormat As String
Dim rngColumn As Range
Dim rngTofind As Range
Dim i As Long

'******************************************
'Edit the following line to the number of _
digits in the Set label _
NOTE: Zeros not aplha characters
strFormat = "00"
'*******************************************

On Error Resume Next
lngCol = Application.InputBox _
(Prompt:="Select the column with the" & _
"Set xx labels", _
Title:="Data Select", Type:=8).Column

If Err.Number > 0 Then
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If
On Error GoTo 0 'Reset error trapping

Set rngColumn = Columns(lngCol)

'Last row of column with incrementing data sets
lngLastRow = Cells(Rows.Count, _
lngCol + 2).End(xlUp).Row

varSet1 = Application.InputBox _
(Prompt:="Enter first set number to delete.", _
Title:="Delete Selection", Type:=1)

If varSet1 = False Then
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If

varSet2 = Application.InputBox _
(Prompt:="Enter second set number to delete.", _
Title:="Delete Selection", Type:=1)

If varSet2 = False Then
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If

varSet1 = "Set " & Format(varSet1, strFormat)
varSet2 = "Set " & Format(varSet2, strFormat)

Set rngTofind = rngColumn.Find(What:=varSet1, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngTofind Is Nothing Then
i = rngTofind.Row
Do
Range(Cells(i, lngCol), Cells(i, lngCol + 7)) _
.Interior.ColorIndex = 6

i = i + 1
Loop While Cells(i, lngCol) <= varSet2 _
And i <= lngLastRow

Else
MsgBox "Numberset " & varSet1 & " not found." _
& vbLf & "Processing terminated."
Exit Sub
End If

'*************************************
'Remove the Exit sub and run again
'if you are satisfied that the highlighted
'rows are the correct ones to delete.
Exit Sub
'*************************************

For i = lngLastRow To 2 Step -1
If Cells(i, lngCol).Interior.ColorIndex = 6 Then
Range(Cells(i, lngCol), _
Cells(i, lngCol + 7)).Delete
End If
Next i


End Sub


Regards,

OssieMac