adding search buttons to excel list

[Guest]

I have a phone list I publish on our intranet. It's excel based. I want to add buttons on the top, similar to what the newer version of Outlook has in the contact list, so people can just click on the "AB" button and the list automatically scrolls down to last names beginning with either A or B appear on the screen.

 

[Dave Peterson]

If this is an excel file that is downloaded from the internet, then this worked
ok for me.

(I don't know what'll happen if you publish it to the net.)

I ran a macro to add 13 buttons to a worksheet. I put them in A1 and let them
grow to the right. (Change the leftmostcell to where you want it to start and
change the width to make it look pretty (20 looked ok for me).)

The macro that does the work looks for a range name like Let_AB, Let_CD, ...,
Let_YZ. If you don't have the correct name, you'll hear a beep.

I'd put headers before each group and then Insert|Name|Define and define the 13
ranges that way.

This macro only needs to be run once.

Option Explicit
Sub runThisOneTimeOnly()

Dim myCell As Range
Dim iCtr As Long
Dim wks As Worksheet
Dim LeftMostCell As Range
Dim myBTN As Button
Dim BTNLeft As Double
Dim BTNWidth As Double

Set wks = ActiveSheet

With wks
.Buttons.Delete 'gets rid of ALL buttons
Set LeftMostCell = .Range("a1")
BTNLeft = LeftMostCell.Left
BTNWidth = 20
For iCtr = Asc("A") To Asc("Z") Step 2
Set myBTN = .Buttons.Add(Top:=LeftMostCell.Top, _
Width:=BTNWidth, _
Height:=LeftMostCell.Height, _
Left:=BTNLeft)
BTNLeft = BTNLeft + BTNWidth 'get ready for next time
With myBTN
.Caption = Chr(iCtr) & Chr(iCtr + 1)
.Name = "BTN_" & .Caption
.OnAction = ThisWorkbook.Name & "!GotoLetter"
End With
Next iCtr
End With

End Sub

'This is the macro that does the work!
Sub GoToLetter()

Dim myBTN As Button
Dim rng As Range
Set myBTN = ActiveSheet.Buttons(Application.Caller)

Set rng = Nothing
On Error Resume Next
Set rng = ActiveSheet.Range("LET_" & myBTN.Caption)
On Error GoTo 0

If rng Is Nothing Then
Beep 'design error
Else
Application.Goto rng, scroll:=True
End If

End Sub


I wanted to test it on a worksheet. This code just adds a bunch of nice range
names and labels them to test the other code.

I used Window|Freeze Panes under the buttons and it seemed to work ok.

Sub testitout()

Dim iCtr As Long

For iCtr = Asc("A") To Asc("Z") Step 2
With ActiveSheet.Cells((iCtr - Asc("A")) * 3 + 3, 1)
.Name = "Let_" & Chr(iCtr) & Chr(iCtr + 1)
.Value = Chr(iCtr) & Chr(iCtr + 1)
End With
Next iCtr

End Sub