Excel formules omzetten naar werkende VBA macro

[Esducsafe]

@ Helpers,
Op mijn werkblad heb ik twee formules uitgewerkt, die controleren of de invoer juist is. Als de invoer onjuist is, verschijnt er een Foutbericht in Kolom H of Kolom I.(zie onderstaande formules). Als de tweede formule een foutbericht geeft is deze tekst niet geheel zichtbaar. Daarom heb ik geprobeerd de formules om te zetten in een VBA code, zodat in plaats van de foutberichten er een MsgBox message op het scherm verschijnt. Intussen heb ik wel gevonden hoe ik de formules, m.b.v. de Macrorecorder, in een VBA code kan omzetten. Echter bruikbare voorbeelden (Internet en boeken) hoe de deze codes verder moet bewerken tot een werkende VBA code heb ik, na de nodige uurtjes zoeken, niet kunnen vinden. Wie kan mij (op weg) helpen?.
Alvast bedankt,
Esko

Excel formule 1 in Kolom H
{=ALS(ISNB(VERT.ZOEKEN(B7;$N$6:$N$620;1;0));"Fout! Invoer onjuist";"")

Range (H7:H57”).Select
ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-6],R6C14:R620C14,1,0)),""Fout! Invoer onjuist."","""")"

Excel formule 2 in Kolom I
{=ALS(EN(E7>1;B7=0);"FOUT! Geen …";"")

Range("I7:I57").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-4]>1,RC[-7]=0),""FOUT! Geen Gb-rek ingevuld"","""")"

 

[ExcelAmateur]

Esducsafe,

De code kun je zo schrijven.

Sub VulCel()
'Excel formule 1 in Kolom H
[H7:H57] = "=IF(ISNA(VLOOKUP(RC[-6],R6C14:R620C14,1,0)),""Fout! Invoer onjuist."","""")"
'Excel formule 2 in Kolom I
[I7:I57] = "=IF(AND(RC[-4]>1,RC[-7]=0),""FOUT! Geen Gb-rek ingevuld"","""")"
End Sub

Hier geeft hij een MsgBox met de fout melding, alleen op kolom E.
Misschien kun je hier wat mee?

Sub VulCel()
'Excel formule 1 in Kolom H
[H7:H57] = "=IF(ISNA(VLOOKUP(RC[-6],R6C14:R620C14,1,0)),""Fout! Invoer onjuist."","""")"
'Excel formule 2 in Kolom I
[I7:I57] = "=IF(AND(RC[-4]>1,RC[-7]=0),""FOUT! Geen Gb-rek ingevuld"","""")"

  For Each CL In [E7:E57]
    If CL = "" Then Exit Sub
    If CL > 1 Then MsgBox "Fout! Geen Gb-rek ingevuld"
  Next
End Sub

 

[Esducsafe]

Excel formule VlookUp naar werkende VBA macro

@ ExcelAmateur,
Dank voor je bijdrage. Helaas heb ik daarmee nog niet de oplossing gevonden. In bijgevoegd bestandje heb ik een eerste aanzet kunnen samenstellen. Helaas werkt het nog niet voor de gehele invoerkolom. Heeft iemand een idee hoe de code aangepast moet worden?
Alvast bedankt,
Esko

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range, i As Long
Item = Range("D1")
List = Range("N1:N10")
On Error Resume Next
Search = WorksheetFunction.VLookup(Item, List, 1, False)
If Err > 0 Then
    Range("H1") = "waarde NOT FOUND"
Else
    Range("H1") = "" ' Search  
End If
On Error GoTo 0
End Sub

 

[ExcelAmateur]

Esducsafe,

Zo iets?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range, i As Long

Item = Range("D1")
List = Range("N1:N10")

On Error Resume Next
Search = WorksheetFunction.VLookup(Item, List, 1, False)
 For Each CL In [N1:N10]
    If CL = "" Then Exit Sub
    If CL > 0 Then MsgBox "waarde NOT FOUND"
  Next
On Error GoTo 0
End Sub

 

[Esducsafe]

@ExcelAmateur
Dank voor je bijdrage. Helaas werkt je code (nog) niet. Zelf getest?
Groet,
Esko

 

[Warme bakkertje]

Deze werkt voor de tabel op Blad1

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 2 And [Blad1!N2:N10].Find(Target, , xlValues, xlWhole) Is Nothing Then MsgBox "Fout!Geen juiste invoer", vbExclamation

If Target.Column = 5 And Cells(Target.Row, 2) = "" Then MsgBox "Fout!Geen waarde in kolom B ingevuld", vbExclamation

End Sub

 

[Esducsafe]

@Rudi,
Code werk! Weer wat (VBA) wijzer.
Hartelijk dank,
groet
Esko

 

[Esducsafe]

Controle op geldige invoer met Excel formule en VBA

Aan de hand van een eerste aanzet, ontvangen van Rudi (het Warme bakkertje, waarvoor nogmaals dank) heb ik mijn casus als onderstaande uitgewerkt. Eventuele verbetering van experts zijn natuurlijk welkom. Zie ook bijgevoegd bestandje. Wellicht dat anderen hier ook wat aanhebben.
Esko

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iReply As Integer


 On Error Resume Next

 If Not Intersect(Target, Range("B2:F10")) Is Nothing Then
    If Target.Column = 2 And [N2:N10].Find(Target, , xlValues, xlWhole) Is Nothing Then
        
         If Target <> 0 Then
            iReply = MsgBox("Het ........is " & vbCrLf & _
            ".....", vbCritical, "Invoer Fout!")
                Target.ClearContents
     End If
End If

   If Target.Column = 3 And [N2:N10].Find(Target, , xlValues, xlWhole) Is Nothing Then
                
         If Target <> 0 Then
            iReply = MsgBox("Het ........is " & vbCrLf & _
            ".....", vbCritical, "Invoer Fout!")
                Target.ClearContents
  End If
End If
   
   If Target.Column = 5 And Cells(Target.Row, 2) = "" Then
   
         If Target <> 0 Then
            iReply = MsgBox("Er is nog geen ....." & vbCrLf & _
            "in kolom B ingevuld.", vbCritical, "Invoer Fout!")
                Target.ClearContents

    End If
End If