Excel/VBA email adres zoeken in een lijst en makkelijk nieuwe adressen toevoegen.

Status
Niet open voor verdere reacties.

michael755

Gebruiker
Lid geworden
3 mrt 2016
Berichten
28
Morgen allemaal,

Ben ik weer. Ben al enkele dagen aan het stoeien met mijn servicerapport. Ben heel goed geholpen door cobe bij dit bericht https://www.helpmij.nl/forum/showthread.php/886079-Zoeken-in-een-lijst-met-zinnen-naar-een-willekeurig-woord-met-excel-of-vba

Nu zit ik met een nieuw probleem. Ik gebruik het rapport al vanaf 2016 nu gaan mijn collega's het ook gebruiken.
Probleem waar mijn collega's tegen aan lopen: We moeten een contact persoon invullen links boven in het document, op dit moment gebruik ik gegevensvalidatie om het juiste e-mailadres op te zoeken in een lijst van ong. 1000 namen en adressen. Nu komt het vaak voor dat je bij een nieuwe klant komt en dat het adres nog niet in de lijst staat. Voor mij is het heel simpel om een nieuw adres in te vullen in het tabje namen. Mijn collega's hebben hier problemen mee.

Nou ben ik opzoek naar een oplossing om het e-mailadres heel simpel toe te voegen. Het liefst wil ik een apart excel bestandje maken met de namen en e-mail adressen en deze koppelen aan het servicerapport. Omdat we eigenlijk nooit beginnen met het email adres in te vullen zou het fijn zijn als er met VBA iets gemaakt kan worden waarbij het doorzoeken van de mail heel makkelijk te doen is en dat er heel makkelijk een nieuw e-mail adres kan worden opgeslagen zonder dat het servicerapport opgeslagen zal worden (daarom een los bestandje voor de e-mailadressen en namen).
Op dit moment zit er wat denkwerk achter. Ik zoek namelijk de eerste letter van de naam van het contactpersoon erbij en de achternaam vult ook automatisch in.

Hoop dat ik het een beetje duidelijk heb kunnen uitleggen en dat iemand mij hier mee zou willen helpen.

Alvast hartelijk dank.

Groetjes Michael
Bijlage opzetje VBA en het servicerapport met iets minder Namen en e-mailadressen.

Kleine opmerking de screenshot heb ik niet werkend kunnen krijgen in VBA, Deze zit niet meer in het servicerapport.
 

Bijlagen

  • vba.png
    vba.png
    115,4 KB · Weergaven: 61
  • Servicerapport (V05-2019) voor helpmijRev2.xlsb
    117,2 KB · Weergaven: 30
Laatst bewerkt:
Misschien dat het te lastig is zoals ik het wil.

De e-mailadressen mogen ook in dezelfde werkmap blijven staan. Als het maar mogelijk is op een simpele manier een e-mailadres toe toe voegen op blad 1.

Is er een mogelijkheid om de achternaam, de voorletter en het e-mailadres zelf in te vullen zonder de beveiliging eraf te halen? Op deze manier kan het servicerapport gewoon gebruikt worden en pas ik 1 keer per 3 maanden de e-mailadressen lijst aan.

Kwam zelf deze net tegen, krijg hem alleen niet aan de praat.

Dim Msg, Style, Title, Help, Ctxt, Response
Sub CheckRange()
Dim isect As Range
Dim strDescript As String
Dim strVentPrix As Single
Dim strMPPrix As Single
Dim strSuppliersRef As String
Dim dateDatePrix As Date
On Error GoTo Error_Handler
Set isect = Application.Intersect(MyRange, Range("Zoek"))
Application.EnableEvents = False
If Not isect Is Nothing Then
'MsgBox myRange, vbCritical
If Not MyRange.Value = Empty Then
strDescript = Application.WorksheetFunction.VLookup(MyRange, Worksheets("Namen").Range("Namen"), 2, False)
strVentPrix = Application.WorksheetFunction.VLookup(MyRange, Worksheets("Namen").Range("Namen"), 3, False)
strSuppliersRef = Application.WorksheetFunction.VLookup(MyRange, Worksheets("Namen").Range("Namen"), 4, False)
strMPPrix = Application.WorksheetFunction.VLookup(MyRange, Worksheets("Namen").Range("Namen"), 5, False)
dateDatePrix = Application.WorksheetFunction.VLookup(MyRange, Worksheets("Namen").Range("Namen"), 6, False)
MyRange.Offset(0, 2).Value = strDescript
MyRange.Offset(0, 5).Value = strVentPrix
MyRange.Offset(0, 11).Value = strSuppliersRef
MyRange.Offset(0, 12).Value = strMPPrix
MyRange.Offset(0, 13).Value = dateDatePrix
End If
End If
Application.EnableEvents = True
Exit Sub ' Exit to avoid handler.
Error_Handler: ' Error-handling routine.
'MsgBox Err
If Err = 13 Then
'MsgBox "This works only with one cell selected!", vbCritical
Else
Msg = "Naam. niet gevonden! Zelf invullen?. ?" ' Define message.
Style = vbYesNo + vbExclamation + vbDefaultButton2 ' Define buttons.
Response = MsgBox(Msg, Style)
If Response = vbYes Then ' User chose Yes.
If Not MyRange.Offset(0, 2).Value = Empty Then
Msg = "Delete the description and the price ? " ' Define message.
Style = vbYesNo + vbInformation + vbDefaultButton2 ' Define buttons.
Response = MsgBox(Msg, Style)
If Response = vbYes Then ' User chose Yes.
MyRange.Offset(0, 2).Value = ""
MyRange.Offset(0, 5).Value = ""
End If
End If
End If
End If
'MsgBox Err
Err.Clear ' Clear Err object fields
Application.EnableEvents = True
End Sub

Alvast bedankt.

Groet Michael

In de bijlage het stukje waar het over gaat.
 

Bijlagen

  • email.png
    email.png
    1,4 KB · Weergaven: 30
Laatst bewerkt:
Pas 150 keer bekeken en ook ik ben afgehaakt om er een oplossing voor te verzinnen. Er is zonder een halve dag studie geen touw aan vast te knopen. Ik denk ook niet dat jouw collega's problemen met het bestand hebben, maar dat de ontwikkelaar van dit bestand een probleem heeft.

Er is vast wel iemand hier die je verder kan helpen maar begin dan eerst met:
  • een concrete vraag;
  • een voorbeeldbestand met de juiste indeling en wat waar staat. Nu zweeft er van alles in de diverse tabjes;
  • Alleen de relevante code of benoem in iig waar wat staat.
  • De geplaatste code in #2 moet je nog even voorzien van codetags. Dit is nu een onleesbaar breiwerk van letters.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan