Two Parter: filter list and search for a match for the password

[RyGuy]

I am trying to create a sub that prompts a user for an input, in this case a
number from 1-5, and then takes this value and enters it into the Excel
filter tool. I’m trying to get all the records that are listed on each line
to be copied/pasted to a sheet called “Resultsâ€. I almost have the filter
part working, but not quite. It fails on the following line:

With myCell.CurrentRegion



My code is shown below:

Sub FilterList()
Dim mySht As Worksheet
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer
myShtName = ActiveSheet.Name
Number = InputBox("What number do you want to find?")
Set myArea = ActiveCell.CurrentRegion.Columns(6).Offset(1, 0).Cells
Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)
Set mySht = Worksheets.Add(Before:=Worksheets(1))
mySht.Name = "Results"
With myCell.CurrentRegion
.AutoFilter Field:=6, Criteria1:=Number
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
End Sub



Also, I am trying to set some kind of security so that if the user enters a
“1â€, the user would then be prompted for a password and would have to enter
the correct password or the sub would not run (my supervisor’s idea). I am
still a ways away from achieving this second goal of matching the “1â€, “2â€,
etc. with the appropriate password… I’m thinking of creating five similar,
but different, macros so that if a user enters “1†Excel will search for a
match for the password (embedded in the macro) and determine if the user has
permission to see the results of the filtered list. Can this be done? Can
anyone help me with these two tasks or point me in the right direction?

Regards,
Ryan---

 

[Tom Ogilvy]

The obvious reason that I see is that the variable mycell has never been
initialized. You were using myarea in previous parts of the code.

Of course it could be global variable, but I will wait for confirmation
before looking further.

 

[RyGuy]

Tom, you are right on target, as usual. I did not Dim the myCell variable (I
noticed that after I posed here). I turned on the recorder and put together
a much simpler routine:

Sub Filt()
Application.ScreenUpdating = False
Dim Number As Integer
Sheets("What Column Number").Visible = True
Sheets("What Column Number").Select
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
Number = InputBox("What Security level are you?")
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=6, Criteria1:=Number
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets("Sheet").Select
Range("A11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("What Column Number").Select
ActiveWindow.SelectedSheets.Visible = False
Application.ScreenUpdating = True
End Sub

I found the other Sub on the web (forgot where) and it was set up for
looping. The design was great, but for my purpose, I just needed one sheet
built, not several, so I tried to modify the loop and I messed it up big
time. The logic is much simpler because I'm just building one new sheet now
(I should have done that in the first place). Any thoughts on the other
question? Is there a way to match the “1â€, “2â€, etc. with the appropriate
password?

Cordially,
Ryan---

 

[Tom Ogilvy]

' Dim number as Integer
Dim number as Variant
Dim v as Variant, ans as string
v = Array("House","Car","Password3","Moon","Sky")
Number = Application.InputBox("What Security level are you?",type:=1)
if Number = False then exit sub
if number < 1 or number > 5 then exit sub
Number = int(number)
ans = InputBox( "What is your password for security level " & Number & "?")
if lcase(ans) <> lcase(v(Number - 1)) then
Msgbox "Bad password"
exit sub
End if

 

[RyGuy]

I guess timing is everything! I checked the DG, a short time ago, and didn't
see any new responses to my question, so I tested a few things and got my
macro (below) working. Then, I logged in to give you feedback Tom, and I
just saw your second response! Thanks a lot. I'm going to try your code in
a just a moment. I wanted to post my solution here, in case others
encountered a dilemma similar to my own...

Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function ReturnUserName() As String
' returns the NT Domain User Name
Dim rString As String * 255, sLen As Long, tString As String
tString = ""
On Error Resume Next
sLen = GetUserName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen > 0 Then
tString = Left(rString, sLen - 1)
Else
tString = rString
End If
On Error GoTo 0
ReturnUserName = LCase(Trim(tString))
End Function

Sub Filt()
Application.ScreenUpdating = False
On Error Resume Next
Dim Number As Integer
Sheets("What Column Number").Visible = True
Sheets("What Column Number").Select
Range("J1").Select
Selection = "=ReturnUserName()"
If Range("J1").Text = oprince Or Range("J1").Text = hsmith = Then
Number = 2
Else
MsgBox ("Unauthorized.")
Sheets("Sheet").Select
Exit Sub
End If
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
Range("I1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:=Number
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets("Sheet").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
On Error Resume Next
Number = 0
Sheets("What Column Number").Select
Sheets("What Column Number").Visible = False
Application.ScreenUpdating = True
End Sub

I topped it off by making the sheet "What Column Number" very hidden, and
adding a VBA password (which we all know is feeble at best, but in this case
it will probably be ok).

Tom, your code seems much more elegant to my own. When I was testing a few
options earlier today, I thought my solution would suffice because I work at
a small firm and I can easily add a few more items such as :
Range("J1").Text = blah, blah, blah,

Thank you so much Tom, and any others who checked out this post.

Regards,
Ryan--

 

[RyGuy]

Just tried the code Tom!
Right on!!!

Thanks,
Ryan---