User inserted value

J

J.W. Aldridge

Code works, but I need to alter the filter to replace the code portion
"ABC", with a popup box that asks the user what is the name of their
group, so that all other rows are deleted instead of having it in the
code.


Sub DeleteRows()

Dim LastRow As Long
Dim rw As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "c").End(xlUp).Row
For rw = LastRow To 2 Step -1
If Cells(rw, "c").Value <> "ABC" Then
Rows(rw).Delete Shift:=xlUp
End If
Next rw
Application.ScreenUpdating = True
End Sub
 
J

J.W. Aldridge

Ok... Trying to put this all together but not quite sure where I'm
losing it.
Created the line "x=inputbox..."
Also changed the reference to x, however it doesn't quite work. I cant
even cancel out of the message box.
Any ideas..., help..., please?

Sub DeleteRows()


Dim LastRow As Long
Dim rw As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "c").End(xlUp).Row
For rw = LastRow To 2 Step -1

x = InputBox("Type three letter dept code please", "Department
Filter")

If Cells(rw, "c").Value <> x Then
Rows(rw).Delete Shift:=xlUp
End If
Next rw
Application.ScreenUpdating = True
End Sub
 
D

Dave Peterson

You only want to ask the user for the deptcode to keep a single time. So you
don't want to put it a loop.

Maybe this will be closer:

Option Explicit
Sub DeleteRows()

Dim LastRow As Long
Dim rw As Long
Dim DeptCode As String

DeptCode = InputBox(Prompt:="Please type three letter dept code to keep", _
Title:="Department Filter")

If Len(Trim(DeptCode)) <> 3 Then
MsgBox "That's not 3 characters!"
Exit Sub
End If

Application.ScreenUpdating = False
With ActiveSheet 'I like to qualify my ranges
LastRow = .Cells(.Rows.Count, "c").End(xlUp).Row
For rw = LastRow To 2 Step -1
If LCase(.Cells(rw, "c").Value) <> LCase(DeptCode) Then
.Rows(rw).Delete
End If
Next rw
End With
Application.ScreenUpdating = True

End Sub
 
B

Bob Phillips

This should work

Sub DeleteRows()


Dim LastRow As Long
Dim rw As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "c").End(xlUp).Row
For rw = LastRow To 2 Step -1

x = InputBox("Type three letter dept code please", "Department
Filter")

If Cells(rw, "c").Value <> x Then
Rows(rw).Delete Shift:=xlUp
End If
Next rw
Application.ScreenUpdating = True
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top