Controle inhoud cellen met vba

[dinge]

Goedendag allemaal

Ik heb een probleempje met een controle van cellen met inhoud.
als is via een commandbutton een aantal rijen met inhoud wil kopieren naar een ander tabblad zouden eerst de cellen gecontroleerd moeten worden op inhoud.
In de cellen staat een cijfer met daarachter een A, B, C of D.
Als deze letters in de betreffende cellen staan is het goed en mag het geheel gekopieerd worden.
Staat er een andere letter dan de bovenstaande 4 in de cel dan mag het geheel niet gekopieerd worden, maar zou ik een melding moeten krijgen dat er een verkeerde indeling is gemaakt.
Iemand heeft voor mij een code samengesteld alleen deze werkt niet helaas.
Hieronder de code die ze hiervoor gebruikt hebben.

'Controleren of er geen andere doelen zijn dan A, B, C of D.
For x = 5 To MaxSchutters
Doel = Cells(x, "g").Value2
If InStr(1, Right(Doel, 1), "ABCD", vbTextCompare) Then
MsgBox Doel & " is geen correct doel"
GoTo Einde
End If
Next x

Kan iemand mij een code geven die dit wel controleert.
Ik heb het idee dat er iets mist, maar dit is het enigste stukje dat over controle gaat, en ik kan niet verzinnen wat er mist.
Het mooiste is dat ook de cel een kleur krijg zodat het opvalt om welke cel het gaat.
Heb een voorbeeld erbij gedaan zoals het eigen zou moeten

Bekijk bijlage voorbeeld controle baanindeling.xlsx

 

[HSV]

Bv.

Sub hsv()
For x = 5 To 20
 For Each arr In Array("A", "B", "C", "D")
    If InStr(LCase(Cells(x, 7)), LCase(arr)) Then y = y + 1
  Next arr
If y = 0 Then MsgBox Cells(x, 7) & " is geen correct doel"
 y = 0
Next x
End Sub

 

[dinge]

Goedendag Harry

Dank je wel voor je oplossing.
Hij geeft aan welke fout ik heb ingevoerd.
Eerst krijg ik de melding te zien dat bijv. 1f geen correct doel is daarna moet ik nog een aantal keer klikken tot eind bereik.
Ik krijg dan steeds de melding geen correct doel.
Is het mogelijk om maar 1 keer op OK te hoeven klikken en dat ik dan wel een correct doel in kan vullen?
Is het mogelijk om de cel met de fout ook een kleur te geven, zodat het meteen opvalt?

 

[Jack Nouws]

Zo misschien

Sub hsv()
For x = 5 To 20
 For Each arr In Array("A", "B", "C", "D")
    If InStr(LCase(Cells(x, 7)), LCase(arr)) Then y = y + 1
  Next arr
If y = 0 Then
  Cells(x, 7).Interior.Color = vbRed
  n= n+ 1
End If
 y = 0
Next x
MsgBox ("Er zijn " & n & " fouten gevonden")
End Sub

 

[HSV]

Zo kan je het gelijk wijzigen.

Sub hsv()
Dim sv, arr, herstel, i As Long, y As Long
sv = Range("f4").CurrentRegion
For i = 2 To UBound(sv)
 For Each arr In Array("A", "B", "C", "D")
    If InStr(LCase(sv(i, 2)), LCase(arr)) Then y = y + 1
  Next arr
 If y = 0 Then
   herstel = Application.InputBox(sv(i, 2) & "  is geen correct doel", "Fout")
   If herstel <> False Then sv(i, 2) = herstel
 End If
 y = 0
Next i
Range("f4").Resize(UBound(sv), 2) = sv
End Sub

 

[dinge]

Goedendag Heren

Ik heb beide codes geprobeerd zowel van Jack en de tweede van Harry.
Bij die van Jack word de cel met de fout rood aangegeven.
Ook word er aangegeven hoeveel fouten er zijn.
Alleen als ik de fouten verbeterd heb dan blijft het programma aangeven dat er fouten zijn terwijl ik ze verbeterd heb.
Ik krijg dan ook niets gekopieerd.

In de oplossing van Harry word er aangegeven welke fout er is gemaakt en krijg ik de mogelijkheid om het met een invulbox te veranderen.
Dat is op zich ook wel handig alleen er gebeuren allerlei dingen die ik niet wil.

Ik heb van alles geprobeerd, maar kom er niet aan uit.

Ik doe er daarom maar het programmaatje bij waarin het heb proberen te plakken.
De bedoeling is als ik op het tabblad inschrijvingen op de button van Uitslag maken klik eerst de baanindeling word gecontroleerd en eventuele fouten worden aangegeven.
Zijn er fouten dan moeten deze eerst verbeterd worden.
Zijn er geen fouten, of geen fouten meer, dan zouden de ingevulde fouten naar het tabblad uitslag gekopieerd moeten worden.

Bekijk bijlage Nieuwe scoresheet test 2.xlsm

 

[VenA]

Invoercontrole kan je beter vooraf doen. Zoek maar even op gegevensvalidatie.

 

[HSV]

Goedendag Heren

In de oplossing van Harry word er aangegeven welke fout er is gemaakt en krijg ik de mogelijkheid om het met een invulbox te veranderen.
Dat is op zich ook wel handig alleen er gebeuren allerlei dingen die ik niet wil.

Bekijk bijlage 312449

Omschrijf het eens.

 

[dinge]

Goedemorgen

Er word wel aangegeven welke fout er in staat.
Dat stuk gaat goed.
Alleen als ik hem verbeter word er ook een andere kolom ingevoerd.
Ik heb gehad dat de kolom van naam ingevoerd werd of de kolom van plaats en alles schuift een stukje op.
Baannr. wordt wel veranderd.
Het is de bedoeling dat andere personen met dit programma gaan werken, daarom had ik het ingebouwd willen hebben.

Ik heb er een voorbeeld bij gedaan van het resultaat.


Bekijk bijlage Nieuwe scoresheet test 3.xlsm

 

[HSV]

Nogal wiedes als je nieuw bestand er anders uit ziet dan je eerste.

Ik neem aan dat het om kolom H gaat.

Sub hsv()
Dim sv, arr, herstel, i As Long, y As Long
With Sheets("inschrijvingen")
.Unprotect
sv = .Range("A5").CurrentRegion
    For i = 2 To UBound(sv)
      For Each arr In Array("A", "B", "C", "D")
        If InStr(LCase(sv(i, 8)), LCase(arr)) Then y = y + 1
      Next arr
     If y = 0 Then
       herstel = Application.InputBox(sv(i, 8) & "  is geen correct doel", "Fout")
       If herstel <> False Then sv(i, 8) = herstel
     End If
     y = 0
    Next i
.Range("A5").Resize(UBound(sv), UBound(sv, 2)) = sv
.Protect
End With
End Sub

Of een lusje minder.

Sub hsv()
Dim sv, arr, herstel, i As Long
With Sheets("inschrijvingen")
.Unprotect
sv = .Range("A5").CurrentRegion
    For i = 2 To UBound(sv)
        If Not LCase(sv(i, 8)) Like "#[a-d]" Then
       herstel = Application.InputBox(sv(i, 8) & "  is geen correct doel", "Fout")
       If herstel <> False Then sv(i, 8) = herstel
     End If
    Next i
.Range("A5").Resize(UBound(sv), UBound(sv, 2)) = sv
.Protect
End With
End Sub

 

[dinge]

Goedenavond Harry

Het laatste bestand wat ik erbij had gedaan was hetzelfde als de 2e versie.
Alleen bij de 3e versie wilde ik laten zien dat er een kolom ingevoegd werd.
Want de gegevens van kolom H stonden eerst in kolom G en de kolommen A en B zijn hetzelfde geworden.
Ik had het allereerste bestand met minder gegevens gedaan omdat ik er vanuit ging dat ik het wel aangepast kreeg, maar helaas lukte me dat niet.
Sorry dat ik zo geredeneerd had.
Ik wil je hartelijk danken voor de oplossing hier kan ik weer mee vooruit.

 

[HSV]

Graag gedaan Corné.

In je openingspost kan je de vraag als opgelost markeren als er geen vragen meer over zijn.
Bvd.