Find and delete data based on header row values...

[dpmicka]

I have a sheet with a header row (A1:D4 = Blue, Yellow, Green, Red). The values in A2:D1000 might be any single digit number 0-9. Is it possible to set up a macro or some code that will present the user with two input boxes in succession (one for header row value, next for digit value), then delete all values that meet both criterias. For example, if user entered 'Red' in first input box and '3' in second box, code would search for any cells that contained a value of 3 in column D and delete those cells (shifting other cells in D up). Any ideas???

 

[dpmicka]

Sorry... I misspoke on my header row - it is A1:D1 = Blue, Yellow, Green, Red (not A1:D4 as originally posted)...

Thanks in advance for any ideas!

 

[DRJ]

Try this

Option Explicit

Sub Test()

Dim xCol            As Variant
Dim xVal            As Double
Dim c               As Object
Dim LastRow         As Long
Dim x               As Long

xCol = InputBox("What Color??")
xVal = InputBox("What value??")

    With Sheets("Sheet1").Range("A1:D1")
        Set c = .Find(What:=xCol)
    End With
    If c Is Nothing Then Exit Sub
    xCol = c.Column
    LastRow = Cells(65536, xCol).End(xlUp).Row
    For x = 1 To LastRow
        If Cells(x, xCol).Value = xVal Then
            Cells(x, xCol).ClearContents
            Else
        End If
    Next x

End Sub

 

[kkknie]

Jacob is quite fast...

Here's my stab at it. Note there is no error checking, and will fail if the header is not found or a non-integer is entered. Also, I assumed that you have no blank cells in your range.

Sub HeaderDelete()
   
   Dim strHead As String
   Dim intValue As Integer
   Dim i As Integer
   Dim iCol As Integer
   Dim r
   
   Sheets("Sheet1").Select
   
   strHead = InputBox("Header")
   intValue = InputBox("Value")
   
   iCol = 0
   For i = 1 To 4
      If LCase(Cells(1, i).Value) = LCase(strHead) Then iCol = i
   Next
   
   Columns(iCol).Select
   
   For Each r In Selection
      If r.Value = "" Then Exit For
      If r.Value = intValue Then r.Value = ""
   Next

   Columns(iCol).Select
   Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.Delete Shift:=xlUp
   Range("A1").Select
   
End Sub

K

 

[dpmicka]

WOW! That was fast - you folks amaze me!!! DRJ's code worked like a champ - thanks so much!

I got a error at the statement 'Columns(iCol).Select' on the second example when I plugged it into my example sheet - I'll play around with it to see if I can figure out why. By the way, K, do you know if that restaurant called "Somebody's House" is still open in Greenwood (it was close to that Sara Lee/National Textiles plant)? Used to be some great "home cookin'" there!

 

[DRJ]

Glad to help

Take Care

 

[dpmicka]

Trying to modify DRJ's code a bit... I'd like to be able to exit sub if nothing is entered or if cancel is clicked on the second inputbox (got it to work on 1st box, but 2nd behaves different because, I guess, that this variable is defined as 'double'). Also was wondering how I could exit sub (or produce a msgbox) if no matches are found between what's entered in 1st inputbox and what's actually in the header row (i.e. if user enters 'purple' and that's not in header row). I've played with it and searched the board bit can't tweak it to work - any ideas???

Option Explicit

Sub Test()

Dim xCol            As Variant
Dim xVal            As Double
Dim c               As Object
Dim LastRow         As Long
Dim x               As Long

xCol = InputBox("What Color??")
If Len(xCol) = 0 Then Exit Sub
xVal = InputBox("What value??")
'What can I add here to Exit Sub if Cancel clicked or nothing entered?

    With Sheets("Sheet1").Range("A1:D1")
        Set c = .Find(What:=xCol)
    End With
    If c Is Nothing Then Exit Sub
    'If no matches in header row are found, how can I exit sub right then?
    xCol = c.Column
    LastRow = Cells(65536, xCol).End(xlUp).Row
    For x = 1 To LastRow
        If Cells(x, xCol).Value = xVal Then
            Cells(x, xCol).ClearContents
            Else
        End If
    Next x

End Sub

 

[DRJ]

See additions

Option Explicit

Sub test()

Dim xCol            As Variant
Dim xVal            As Double
Dim c               As Object
Dim LastRow         As Long
Dim x               As Long

xCol = InputBox("What Color??")
If Len(xCol) = 0 Then Exit Sub
xVal = InputBox("What value??")

    If xVal = vbNullString Then Exit Sub

'What can I add here to Exit Sub if Cancel clicked or nothing entered?
'See line above

    With Sheets("Sheet1").Range("A1:D1")
        Set c = .Find(What:=xCol)
    End With
    If c Is Nothing Then Exit Sub
    'If no matches in header row are found, how can I exit sub right then?
    'It already does this (If c is nothing means nothing was found, then exit sub)
    
    
    xCol = c.Column
    LastRow = Cells(65536, xCol).End(xlUp).Row
    For x = 1 To LastRow
        If Cells(x, xCol).Value = xVal Then
            Cells(x, xCol).ClearContents
            Else
        End If
    Next x

End Sub

 

[dpmicka]

The 'If xVal = vbNullString Then Exit Sub' doesn't seem to work - if I leave the 2nd input box empty and click ok or click cancel, I get a "Run Time error 13: Type Mismatch" error.

Sorry... I see your "If c is Nothing..." statement and you are correct - it works great - I added a msgbox instead of exit sub to get the desired effect - thanks!

Any other ideas of handling 'cancel' or 'nothing entered' at 2nd input box?

 

[DRJ]

Change the Dim statement for xVal to this

Dim xVal As Variant


Now it should work.