inputbox bij een telefoonlijst

[jackfish]

Gestimuleerd door de snelle en inhoudelijke reacties van forumleden ben ik, verkerend in de wetenschap jullie hulp nodig te hebben, begonnen aan een tweede VBA-project.

In excel 2007 is een omvangrijke telefoonlijst gemaakt waarin de data verdeeld is over drie sheets. Ik wil graag de gebruiker helpen met het toevoegen van een inputbox die verschijnt als het document wordt geopend (de zoekfunctie zit in excel maar is voor digibeten toch te moeilijk)

De gebruiker typt de voor- of achternaam in en klikt op de knop 'zoek'. Dat moet resulteren in ofwel het verschijnen van een messagebox die zowel de voor- en achternaam van de gezochte persoon terug geeft (staan in aparte kolommen maar wel in dezelfde rij) met zowel het vaste als het mobiele telefoonnummer (eveneens in aparte kolommen maar wel in dezelfde rij). Of een melding dat de naam niet voorkomt in de lijst waarna opnieuw een naam ingegeven kan worden.

Ik heb op het www. wel een macro gevonden (weet alleen niet meer waar) maar die voldoet nog niet helemaal. Wie kan mij helpen met de aanpassingen aangezien mijn bestelling bij bol.com nog niet binnen is en elke wijziging die ik aanbreng resulteert in een foutmelding . Gr Jackfish

Bekijk bijlage 147857

 

[Tent84]

Hierbij een eerste aanzet:
Bij het openen van het bestand krijg ik direct een foutmelding, doordat welkomscherm(.show) niet is gedefinieerd; volgens mij moet dit frmZoeken.Show zijn.

Verder zou ik het zoekbereik (binnen frmZoeken;btnZoeken) aanpassen. Nu wordt er alleen in cel A1 gezocht en eventueel aangrenzende gevulde cellen.
Er zijn meerdere mogelijkheden; in plaats van "doelgebied.find" kun je gebruikmaken van cells.find.

 

[jackfish]

Dank je Tent84. Ik ga ermee aan de slag Jackfish

 

[jackfish]

De presentatie van een zoekresultaat via een messagebox heb laten vallen. De volgende code heb ik bij elkaar gesprokkeld. Graag zou ik er nog iets aan toevoegen alleen krijg ik dat niet voor elkaar. De gehele rij van de geselecteerde cel zou een kleurtje moeten krijgen. Wie weet hoe dat in onderstaande formule in te passen?

Sub ZoekInHeleMap()
Dim sSheet As String
Dim strZoek As String
sSheet = ActiveSheet.Name
i = 0
strZoek = InputBox(vbCr & "Geachte collega," & vbCr & vbCr & "Van wie zoekt u het telefoonnummer?", "TurboSearchEngine", "type hier de voor- of achternaam")
If strZoek = "" Then Exit Sub
Worksheets(1).Select

Opnieuw:
ActiveSheet.Range("A1").Select
With ActiveSheet.Range("A:E")
If strZoek = "" Then Exit Sub
Application.ScreenUpdating = False
Set C = .Find(strZoek, LookAt:=xlPart)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
C.Select
i = i + 1
Application.ScreenUpdating = True
If MsgBox("De naam " & strZoek & " is " & i & " keer gevonden" & vbLf & vbLf & vbCr & "Wilt u verder zoeken?", 32 + 4, "TurboSearchEngine") = vbNo Then Exit Sub
Application.ScreenUpdating = False
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress

If ActiveSheet.Index = Worksheets.Count Then
Application.ScreenUpdating = True
If MsgBox("Er is geen collega meer gevonden met de naam: " & strZoek & " " & vbCr & vbCr & "Klik op OK om terug te gaan naar het begin van de telefoonlijst.", 64 + vbOkeonly, "TurboSearchEngine") = vbNo Then End
ActiveSheet.Range("A1").Select
Sheets(sSheet).Select
Else
Application.ScreenUpdating = False
ActiveSheet.Range("A1").Select
Worksheets(ActiveSheet.Index + 1).Select
GoTo Opnieuw
End If
Application.ScreenUpdating = True
Exit Sub
End If

If ActiveSheet.Index = Worksheets.Count Then
If i > 0 Then
Application.ScreenUpdating = True
If MsgBox("Er is geen collega meer gevonden met de naam: " & strZoek & "", 64 + vbOkeonly, "TurboSearchEngine") = vbNo Then End
Else
ActiveSheet.Range("A1").Select
Sheets(sSheet).Select
MsgBox "Er is geen collega met de naam: " & strZoek & " ", 64 + vbOKOnly, "TurboSearchEngine"
Application.ScreenUpdating = True
End If
Sheets(sSheet).Select
Exit Sub
End If
Worksheets(ActiveSheet.Index + 1).Select
GoTo Opnieuw
End With
Application.ScreenUpdating = True
End Sub

 

[jackfish]

Graag zou ik er nog iets aan bovenstaande code toevoegen alleen krijg ik dat niet voor elkaar. De gehele rij van de geselecteerde cel zou een kleurtje moeten krijgen. Wie weet hoe dat in onderstaande formule in te passen? wie kan een hint geven?

 

[Warme bakkertje]

ipv C.Select

C.entirerow.interior.colorindex = 3

 

[jackfish]

Dank je wel Warme Bakkertje voor de reactie. Ik heb de code ingevoegd en het werkt perfect!