Excel VBA kolom check op dubbelingen zo ja vergelijk met.

[marijnb]

Mijn vraag
Ik heb een lijst (kolom) met projecten. Ongeveer 4000. Dat zijn nummers met altijd 4 karakters en soms een letter wat het soort project aanduid. Als een project wijzigt van soort komt er dus een zelfde nummer bij met een andere letter. Ik heb dan 1 project wat overgegaan is van soort a naar soort b. Soort a wordt afgesloten en soort b is het nieuwe lopende project.

In kolom 2 staat J en N. Afgesloten projecten krijgen een J en lopende projecten een N.

Ik wil weten welke projecten er volledig afgesloten zijn. Als ik sorteer op kolom 2 en dan alles met een J van afgemeld kan het zo zijn dat dit project loopt onder een ander soort.

Ik moet dus controleren op dubbelingen van de eerste 4 getallen. Als ze dubbel zijn bestaan er dus meerdere soorten projecten die kunnen lopen. Vervolgens moet er dus in kolom 2 gekeken worden of alles op J staat. Zo ja dan is het project afgesloten. En dat wil ik graag weten

Ik ben al een beetje met VBA aan het stoeien. Maar het wil nog niet helemaal lukken. Kan iemand me op weg helpen.

Alvast bedankt,
Mvg Marijn

[tritimee]

waarom niet gewoon een 3e kolom met daarin =LEFT(A1,4) en dan daarnaast (kolom D) een countifS(C:C;C1;B:B;"J")?

[marijnb]

Bedankt voor je reactie, ik kwam daarmee wel een eind, hij gaf alleen in cijfers aan hoe vaak het project voor komt als ik die formule toepas.

Ik heb even samen met een collega gekeken en we zijn eruit gekomen middels dit VBA script. Ik publiceer het even zodat anderen er wellicht ook iets aan hebben.

Sub check_projecten()
'klaar betekend: Geen N meer in rij

On Error GoTo EXITT:
Application.ScreenUpdating = False

strNietKlaar = "N" 'dit is de waarde als een rij binnen een project nog niet klaar is
intR = 5 'begin rij van de tabel
intKproject = 1 'kolom waar de projectnummers staan
intKklaar = 2 'kolom waar de aangegeven staat of deze rij klaar is

Columns(intKproject).Interior.Pattern = xlNone 'reset de rapportage

Do While Cells(intR, intKproject) <> Empty 'doorgaan totdat de projecten kolom geen inhoud meer heeft
strProject = Mid(Cells(intR, intKproject).Text, 1, 4) 'defenieer het projectnummer
If Len(strProject) < 4 Then
a = MsgBox(strProject & " gaat niet goed", vbCritical, "melding")
End If
intRM = intR 'onthoud de eerste rijnummer van het project
If Cells(intR, intKklaar).Text = strNietKlaar Then boKlaar = False Else boKlaar = True
'reset boKlaar
Do While InStr(1, Cells(intR, intKproject).Text, strProject, vbTextCompare) > 0
'controleer welke rijen bij het project horen
If Cells(intR, intKklaar).Text = strNietKlaar Then boKlaar = False
'als een rij niet klaar is, is het project niet klaar
intR = intR + 1
'doorgaan tot de laatste rij in het project
Loop
If boKlaar = True Then Range(Cells(intRM, intKproject), Cells(intR - 1, intKproject)).Interior.Color = 6723891
If boKlaar = False Then Range(Cells(intRM, intKproject), Cells(intR - 1, intKproject)).Interior.Color = 255
'markeer de eerste rij van een project wat klaar is
Application.StatusBar = Str(intR)
Loop
Application.StatusBar = Str(intR) & " klaar"
Application.ScreenUpdating = True 'reset de screenupdating
Exit Sub
EXITT:
Application.StatusBar = Str(intR) & " het ging fout"
Application.ScreenUpdating = True 'reset de screenupdating
End Sub

Met vriendelijke groet,
Marijn Barendregt