Aanvulling VBA met voorwaarden

[jan excel]

Hallo experts,

Graag zou ik de bestaande VBA-code aangepast willen zien om te voorkomen dat in een Excel file in meerdere tabellen wordt voor komen
dat er meerdere waardes in een kolom staan.
Tabel 1 werkt echter krijg het niet voor elkaar de code uit te breiden zodat ook in tabel 2 deze veiligheid in werking gaat.
Bijlage toegevoegd om te testen en ter verduidelijking.

onderstaand de code voor tabel 1

Private lKolomOud As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Kol As Long, Rij As Long, antw As Variant
Dim Msg As String, Style, Title As String
Msg = "Er is al een waarde ingevoerd in deze kolom, wil je die wijzigen/verwijderen?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Dubbele invoer"

Rij = ActiveCell.Row
If Kol < 1 Or Kol > 6 Then Exit Sub
If Rij >= 15 Then Exit Sub
If Cells(15, Kol) >= 1 Then

antw = MsgBox(Msg, Style, Title)
If antw = vbYes Then Exit Sub
ActiveCell.Offset(0, 1).Select

End If
End Sub

Alvast bedankt.
Jan

 

[jan excel]

Beste Mensen,

Tot nu toe heeft nog niemand gereageerd op mijn vraag, misschien dat jullie denken dat dit zonder VBA-code kan worden opgelost. Echter dit is niet de bedoeling omdat er in het project al meer gegevens validatie staan in VBA code in het zelfde werkblad.

Vandaar dat ik om een VBA code vraag voor dit onderdeel.
Zit al een tijdje te puzzelen maar kom er nog steeds niet uit.



Voor de liefhebbers oplossing zonder VBA-code
Met gegevens validatie- aangepast de volgende formule gebruiken:
=AANTAL.ALS($B$17:$B$27;B17)<=1
Foutmelding benodigde invullen.
In dit voorbeeld geld dit voor tabel 2 kolom B.

Als het niet mogelijk hoor ik het graag ook als mijn vraag niet duidelijk is.

Alvast bedankt.
Jan E

 

[Elsendoorn2134]

Jan,

Hierbij de VBA code om de controle over beide tabellen uit te kunnen voeren.
je moet nog even programeren wat je wilt doen met het antwoord van de vraag (vbYes, vbNo).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Kol As Long, Rij As Long, antw As Variant
Dim Msg As String, Style, Title As String
Dim rSect As Range

Msg = "Er is al een waarde ingevoerd in deze kolom, wil je die wijzigen/verwijderen?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Dubbele invoer"

Set rSect = Application.Intersect(Worksheets("Blad1").Range("B3:F13"), Target)
If rSect Is Nothing Then
Else
    Kol = ActiveCell.Column
    Rij = ActiveCell.Row
    If Cells(15, Kol) >= 1 Then
        antw = MsgBox(Msg, Style, Title)
        If antw = vbYes Then Exit Sub
    End If
End If

Set rSect = Application.Intersect(Worksheets("Blad1").Range("B17:F27"), Target)
If rSect Is Nothing Then
Else
    Kol = ActiveCell.Column
    Rij = ActiveCell.Row
    If Cells(29, Kol) >= 1 Then
        antw = MsgBox(Msg, Style, Title)
        If antw = vbYes Then Exit Sub
    End If
End If
End Sub

Veel Succes.

 

[jan excel]

Hoi Elsendoorn2134,

Heel veel dank voor de code werkt zoals gevraagd.

Mijn bedoeling was zodra de code opmerkt dat er al een waarde staat in een kolom om dit te melden.
Dit doet het nu goed dankzij jou.

Nu zou ik nog graag willen zodra de code opmerkt dat er al een waarde staat in de kolom en op de vraag of ik deze wil verwijderen met ja beantwoord dat het dan het getal in deze kolom verwijdert.
Als de vraag met nee wordt beantwoord dat de cursor een plaats naar rechts springt naar de volgende kolom. Dit geld dan natuurlijk voor tabel 1 en 2.

Krijg dit nog niet werkend, weet je toevallig ook hoe dit gerealiseerd kan worden ?

Bij voorbaat dank ik ben ontzettend blij dat ik weer een stap verder ben met het project.
Ga eens kijken of ik een donatie kan geven op dit forum, het is geweldig hoe mensen elkaar helpen en tevens is het zeer leerzaam als beginnende VBA programmeur.


groet,
Jan E



Groet,
Jan E