Inputbox Validation List Excel

[franzeman]

Hallo VBA-ers,
Waarom geeft mijn volgende macro geen reactie op een foutieve ingave?

'------------------------------------------------------------------------------------------------------------------------
Sub Autpen()

Dim strResponse As String
Dim Message, Title As String

Sheets(1).Select
Range("E1").Select

Message = "Voer je codenummer in:" 'stel vraag
Title = "Codenummer" ' stelt titel in
strResponse = InputBox(Message, Title)
Range("E1").FormulaR1C1 = strResponse

With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$Z$1:$Z$10" 'lijst met willekeurige codenummers
.IgnoreBlank = True
.InCellDropdown = False
.InputTitle = ""
.ErrorTitle = "Let op!"
.InputMessage = ""
.ErrorMessage = "Dit is geen geldig codenummer!"
.ShowInput = False
.ShowError = True
End With

Range("F1").Select

End Sub
'------------------------------------------------------------------------------------------------------------------------------

Het betreft een korte lijst met vaste codes, maar voorlopig kan ik alles ingeven zonder de geprogrammeerde foutmelding(!?)

N.B. De cellen zijn opgemaakt als 'tekst', omdat ik met voorloopnullen werk.

Groetjes van Franzeman

 

[Wigi]

Franzeman

Sub Auto_Open()

Dim strResponse As String, Message As String, Title As String
Dim rngList As Range

Set rngList = Range("Z1:Z10")
Sheets(1).Select
With Range("E1")
    .Select
    With .Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
                Formula1:=rngList.Address  'lijst met willekeurige codenummers
        .IgnoreBlank = True
        .InCellDropdown = False
        .InputTitle = ""
        .ErrorTitle = "Let op!"
        .InputMessage = ""
        .ErrorMessage = "Dit is geen geldig codenummer!"
        .ShowInput = False
        .ShowError = True
    End With
End With

Message = "Voer je codenummer in:" 'stel vraag
Title = "Codenummer" ' stelt titel in
strResponse = Application.InputBox(Message, Title, , , , , 2)

If WorksheetFunction.CountIf(rngList, strResponse) > 0 Then Range("E1") = strResponse
Range("F1").Select
End Sub

Wigi

 

[Wigi]

Gebruik ook eens code tags als je code post... dan wordt de code leesbaar.

 

[franzeman]

Gebruik ook eens code tags als je code post... dan wordt de code leesbaar.

Hallo Wigi,
Mijn laatste reactie is kennelijk niet aangekomen, dus ik schrijf nogmaals:

De macro werkt gedeeltelijk. Als een juist codenummer wordt ingegeven, wordt dit in cel
E1 geplaatst. Echter bij foutieve ingave gebeurt er niets en verdwijnt de Inputbox na OK uit beeld. Ik zou dan graag mijn errormessage in beeld krijgen, opdat ik het opnieuw kan proberen.

Misschien wil je nog even meedenken.

Groetjes van Franzeman

 

[Wigi]

Misschien wil je nog even meedenken.

Zo dan misschien?

Sub Auto_Open()

Dim strResponse As String, Message As String, Title As String
Dim rngList As Range

Set rngList = Range("Z1:Z10")
Sheets(1).Select
With Range("E1")
    .Select
    With .Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
                Formula1:=rngList.Address  'lijst met willekeurige codenummers
        .IgnoreBlank = True
        .InCellDropdown = False
        .InputTitle = ""
        .ErrorTitle = "Let op!"
        .InputMessage = ""
        .ErrorMessage = "Dit is geen geldig codenummer!"
        .ShowInput = False
        .ShowError = True
    End With
End With

Message = "Voer je codenummer in:" 'stel vraag
Title = "Codenummer" ' stelt titel in
Do
    strResponse = Application.InputBox(Message, Title, Type:=2)
    If WorksheetFunction.CountIf(rngList, strResponse) > 0 Then
        Range("E1") = strResponse
        Exit Do
    Else
        MsgBox "Dit is geen geldig codenummer!"
    End If
Loop
Range("F1").Select
End Sub

Wigi

 

[franzeman]

Input Validation List Excel

Zo dan misschien?

Sub Auto_Open()

Dim strResponse As String, Message As String, Title As String
Dim rngList As Range

Set rngList = Range("Z1:Z10")
Sheets(1).Select
With Range("E1")
    .Select
    With .Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
                Formula1:=rngList.Address  'lijst met willekeurige codenummers
        .IgnoreBlank = True
        .InCellDropdown = False
        .InputTitle = ""
        .ErrorTitle = "Let op!"
        .InputMessage = ""
        .ErrorMessage = "Dit is geen geldig codenummer!"
        .ShowInput = False
        .ShowError = True
    End With
End With

Message = "Voer je codenummer in:" 'stel vraag
Title = "Codenummer" ' stelt titel in
Do
    strResponse = Application.InputBox(Message, Title, Type:=2)
    If WorksheetFunction.CountIf(rngList, strResponse) > 0 Then
        Range("E1") = strResponse
        Exit Do
    Else
        MsgBox "Dit is geen geldig codenummer!"
    End If
Loop
Range("F1").Select
End Sub

Wigi

Dankjewel Wigi,
Het zat 'm in dat loopje aan het eind van de code. Daar kwam ik niet goed uit, omdat ikzelf in mijn denken 'in een loopje' zat.
Nou ja, hoe dan ook: hier kan ik wat mee. Nogmaals bedankt!

En groetjes van Franzeman

 

[Wigi]

Nogmaals bedankt!

Met plezier gedaan.

Wigi

 

[huijb]

@timmethy Graag een eigen vraag openen. Het is niet netjes om in iemand anders zijn topic jouw probleem aan de orde te stellen.

 

[snb]

Vermijd select en activate in VBA (want overbodig, vertragend en verwarrend)
De voorwaarde om een lus te beëindigen kun je deel laten uitmaken van de lus.
Het gebruik van variabelen die slechts 1 maal voorkomen is overbodig.

Do  
  if [E2]<>"" then MsgBox "Dit is geen geldig codenummer!"
  [E2]=InputBox("Voer je codenummer in:" , "Codenummer", 2)
Loop until WorksheetFunction.CountIf([Z1:Z10],[E2])>0