Reputation: 13
I have a spreadsheet that has 29 columns of headers in row 6. Underneath the 29 headers, there is numerical data that extends to 10000 rows. I want to select a header and then enter a minimum value and a maximum value and any data that exceeds the maximum, or is lower than the minimum for that header column, the row that violates the criteria gets deleted.
I was thinking of a user inputting a minimum and a maximum value in cell A1 and A2 then selecting a header from a drop down box then it runs and removes the rows that violate the boundary conditions. So far I have this.
Sub deleterows()
Application.ScreenUpdating = False
Dim Min As Integer
Dim Max As Integer
Dim i As Integer
Dim HeaderRange As Range
Dim matchval As Double
Dim str As String
'Finding column number for the header
'Header is selected in Row 3, headers for the data is in row 6
matchval = Application.Match(Range("A3"), Range("A6:AC6"), 0)
str = Split(Cells(, matchval).Address, "$")(1)
Set HeaderRange = Range(str & "6:" & str & Cells(6, Columns.Count).End(xlToLeft).Column).Find(What:=str, lookat:=xlWhole)
If Cells(1, 1).Value <> "" And IsNumeric(Cells(1, 1)) Then
Min = Cells(1, 1).Value
End If
If Cells(2, 1).Value <> "" And IsNumeric(Cells(2, 1)) Then
Max = Cells(2, 1).Value
End If
For i = Cells(Rows.Count, HeaderRange.Column).End(xlUp).Row To 7 Step -1
If Cells(i, HeaderRange.Column).Value > Max Or Cells(i, HeaderRange.Column).Value < Min Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
Basically, I'm finding the position of the Header and then finding the address, converting it into a string then using the Column index for that header. Then it finds any cell that violates the minimum and maximum condition and deletes it.
However, when I try running this, I run into errors when I'm trying to use headers that have more than a single character. So if I have a header called "V" it runs fine, however if I have one called "Vradial", I get an error saying "Run-time error '91': Object variable or With block variable not set" for line:
For i = Cells(Rows.Count, HeaderRange.Column).End(xlUp).Row To 7 Step -1
Any help would be greatly appreciated.
Thanks!
Upvotes: 0
Views: 78
Reputation: 157
I found the answer for your direct question "Why only single character headers work". I also noticed that you have an unnecessary redundancy in the code (already mentioned/noticed in the comments by the user "eirikdaude")
When using the Find(What:=str) in the code below, you are finding a letter only (the alphabetic column identifiers). What you should be finding/searching for, is the value (actual text) of the header that is written in the sheet
Set HeaderRange = Range(str & "6:" & str & Cells(6,
Columns.Count).End(xlToLeft).Column).Find(What:=str, lookat:=xlWhole)
You can write the line as follows: (I tested it and works)
Set HeaderRange = Range(str & "6:" & str & Cells(6,
Columns.Count).End(xlToLeft).Column).Find(What:=Range("A3"), lookat:=xlWhole)
The above correction while it works, is unnecessary. If I am not mistaken the code line with the issue is used to find the header column. If so, you already find the correct header column index from the code below.
matchval = Application.Match(Range("A3"), Range("A6:AC6"), 0)
'This is only the correct header column index because the match/search range starts from column "A"
Hence, you can disregard the line that is giving you trouble and write the code as follows: (And do not forget to set Application.ScreenUpdating=True at the end ;D)
Sub deleterows()
Application.ScreenUpdating = False
Dim Min As long 'if you expect the min or max to have decimals use Double or Single rather than Long
Dim Max As long
Dim i As long 'I changed from Integer to Long because 99% of the time Long is better than Integer
Dim matchval As long 'application.match returns a position in an array. Hence Long/Integer are better than Double
'Finding column number for the header
'Header is selected in Row 3, headers for the data is in row 6
matchval = Application.Match(Range("A3"), Range("A6:AC6"), 0)
If Cells(1, 1).Value <> "" And IsNumeric(Cells(1, 1)) Then
Min = Cells(1, 1).Value
End If
If Cells(2, 1).Value <> "" And IsNumeric(Cells(2, 1)) Then
Max = Cells(2, 1).Value
End If
For i = Cells(Rows.Count, matchval).End(xlUp).Row To 7 Step -1
If Cells(i, matchval).Value > Max Or Cells(i, matchval).Value < Min Then
Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Hope this helps you.
Upvotes: 1