Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / September 2007

Tip: Looking for answers? Try searching our database.

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

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
RyGuy - 13 Sep 2007 16:52 GMT
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 - 13 Sep 2007 17:38 GMT
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.

Signature

regards,
Tom Ogilvy

> 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
[quoted text clipped - 38 lines]
> Regards,
> Ryan---
RyGuy - 13 Sep 2007 18:28 GMT
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---

> 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.  
[quoted text clipped - 44 lines]
> > Regards,
> > Ryan---
Tom Ogilvy - 13 Sep 2007 19:46 GMT
' 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

Signature

Regards,
Tom Ogilvy

> 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
[quoted text clipped - 84 lines]
> > > Regards,
> > > Ryan---
RyGuy - 13 Sep 2007 20:02 GMT
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--

> ' Dim number as Integer
> Dim number as Variant
[quoted text clipped - 98 lines]
> > > > Regards,
> > > > Ryan---
RyGuy - 13 Sep 2007 20:22 GMT
Just tried the code Tom!  
Right on!!!

Thanks,
Ryan---

> ' Dim number as Integer
> Dim number as Variant
[quoted text clipped - 98 lines]
> > > > Regards,
> > > > Ryan---
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.