Barcode zoeken

Killerclown · 10 apr 2018

Goedeavond,

Ik heb in excel een formulier gemaakt met textboxes waar ik barcodes kan inscannen. (zie afbeelding)
Als deze gescand zijn en ik de startknop heb ingedrukt, gaat onderstaande code gaan zoeken of de barcodes ook voorkomen in de excel.
Zodra deze gevonden zijn, kleurt de cel lichtgroen.

Maar ik stoot nu op het volgende probleem waar ik even de oplossing niet voor zie.

Het kan voorvallen dat een barcode 2 of meerdere keren wordt gescand en ook 2 of meerdere keren voorkomt in excel.
De eerste keer dat de code de barcode tegenkomt, kleur de cel lichtgroen.
De volgende keer dat ik dezelfde barcode tegenkomt, zou de cel die lichtgroen is moeten overgeslagen worden en de volgende gezocht worden in excel om dan vervolgens ook te kleuren.

Maar daar loop ik vast.

Kan iemand me op weghelpen?

Code:

Dim Found As Range
Dim str As String
Dim i As Integer
Dim strB As String
Dim strE As String

For i = 1 To 20

strB = Mid(Controls("TxtBarcode" & i).Value, 2, 13) & "00"
strE = Right(Controls("TxtBarcode" & i).Value, 8)

'STRING B

Set Found = ActiveSheet.Range("C2", Range("C" & Rows.Count).End(xlUp)).Find(strB)
    If Found Is Nothing Then
        Set Found = ActiveSheet.Range("D2", Range("D" & Rows.Count).End(xlUp)).Find(strB)
            If Found Is Nothing Then
            Controls("Lbl" & i).Caption = "NOK"
            Controls("TxtBarcode" & i).BackColor = RGB(240, 230, 140)
            If Controls("TxtBarcode" & i).Value = "" Then Controls("Lbl" & i).Caption = ""
            If Controls("TxtBarcode" & i).Value = "" Then Controls("TxtBarcode" & i).BackColor = RGB(255, 255, 255)
            Else: Controls("Lbl" & i).Caption = "OK"
            Found.Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
            End With
            End If
    Else
      Controls("Lbl" & i).Caption = "OK"
      Found.Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
        End With
    End If

'STRING E

Set Found = ActiveSheet.Range("C2", Range("C" & Rows.Count).End(xlUp)).Find(strE)
    If Found Is Nothing Then
        Set Found = ActiveSheet.Range("D2", Range("D" & Rows.Count).End(xlUp)).Find(strE)
            If Found Is Nothing Then
            Controls("Lbl" & i).Caption = "NOK"
            Controls("TxtBarcode" & i).BackColor = RGB(240, 230, 140)
            If Controls("TxtBarcode" & i).Value = "" Then Controls("Lbl" & i).Caption = ""
            If Controls("TxtBarcode" & i).Value = "" Then Controls("TxtBarcode" & i).BackColor = RGB(255, 255, 255)
            Else: Controls("Lbl" & i).Caption = "OK"
            Found.Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
            End With
            End If
    Else
      Controls("Lbl" & i).Caption = "OK"
      Found.Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
        End With
    End If

Next i

VenA · 10 apr 2018

Waarom gebruik je geen voorwaardelijke opmaak? Een plaatje van een leeg formulier heeft geen toegevoegde waarde net als het plaatsen van halve code.

HSV · 10 apr 2018

Zoek op de functies:
Do, Loop en FindNext.

Killerclown · 19 apr 2018

Dag iedereen,

Mijn excuses voor het plaatje. In bijlage zit nu het bestand met code.
Ik heb ondertussen al wat aanpassingen gedaan om het beter te laten lopen.
Enkel met FindNext loopt nog iets niet goed.

Als een barcode gevonden is, kleurt de cel in excel.
Als de code dan een gekleurde cel tegenkomt, moet hij naar de volgende zelfde barcode zoeken die dan weer wel of niet gekleurd is. Zodra de cel niet gekleurd is met diezelfde barcode moet de cel kleuren en de code stoppen.
Maar dat lukt niet en ik zie niet waarom. De FindNext lukt niet.

Ziet iemand waarom dit niet lukt?

Het probleem zit hem denk ik in dit stukje code als ik mij niet vergis maar ik zie niet wat er mis is.

Code:

'string gevonden

       Found.Select
       
       'celkleur gevonden
       
      If ActiveCell.Interior.ColorIndex = 2 Then
        Set FoundNext = .FindNext(Found)
            If FoundNext Is Nothing Then
            Lbl1.Caption = "DE BARCODE IS REEDS INGESCAND." & vbNewLine & vbNewLine & "DRUK OP RESET" & vbNewLine & "SCAN EEN VOLGENDE BARCODE."
            Lbl2.Caption = "NOK"
            TxtBarcode1.BackColor = RGB(255, 51, 0)
            End If
            Exit Sub
            
            If Not FoundNext Is Nothing Then
            FoundNext.Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
            Lbl1.Caption = "DE BARCODE IS GEVONDEN." & vbNewLine & vbNewLine & "DRUK OP RESET" & vbNewLine & "SCAN EEN VOLGENDE BARCODE."
            Lbl2.Caption = "OK"
            TxtBarcode1.BackColor = RGB(102, 255, 0)
            End With
            End If
            End If
            Exit Sub

Alvast dank.

Bekijk bijlage barcode005.xlsm

HSV · 19 apr 2018

Er zit ook geen Loop in.

Druk F1 in de VB-editor en type in het zoekvenster: range.findnext.

Killerclown · 23 apr 2018

HSV zei:
Er zit ook geen Loop in.

Druk F1 in de VB-editor en type in het zoekvenster: range.findnext.

Ik zit hopeloos vast.
Als de gekleurde cel met die barcode gevonden is, moet hij gewoon naar de volgende zoeken (binnen de range) die niet gekleurd is en dezelfde barcode heeft en daar stoppen.
Ik heb een loop ingebouwd maar wanneer een cel met kleur gevonden wordt, zoekt hij niet de volgende zonder kleur.

Ik zie het niet meer...

Hieronder mijn aanpassingen:

Code:

Private Sub StringBB()

MsgBox "String B"

    Dim MyYear
    Dim MyDate
    MyYear = Left(TxtDatum, 4) & ""
    MyDate = TxtDatum.Value

    Dim Found As Range
    Dim FoundNext
    Dim strB As String
    Dim firstAddress As String
    Dim C As Range
    Dim WhereFirst As Range
    Dim WhereLast As Range
    Dim whatt As String
    Dim RowLast As Integer
    Dim RowFirst As Integer

'Bepaal de range (=zelfde dag)

    whatt = MyDate
    Set C = Range("A:A")
    Set WhereLast = C.Find(What:=whatt, After:=C(1), SearchDirection:=xlPrevious)
    
    If WhereLast Is Nothing Then
    MsgBox "Deze datum is niet gevonden"
    Exit Sub
    Else
    RowLast = Mid(WhereLast.Address(0, 0), 2)
    Set WhereFirst = C.Find(What:=whatt, After:=C(1))
    RowFirst = Mid(WhereFirst.Address(0, 0), 2)
    End If
      
'Zoek string B

    strB = Mid(TxtBarcode1.Value, 2, 13) & "00"

    With Worksheets(MyYear).Range("C" & RowFirst, "C" & RowLast)
    Set Found = .Find(strB)

'string niet gevonden

      If Found Is Nothing Then
        TxtBarcode1.BackColor = RGB(204, 51, 0)
        Lbl1.Caption = "DE BARCODE IS NIET GEVONDEN." & vbNewLine & vbNewLine & "DRUK OP RESET" & vbNewLine & "SCAN EEN VOLGENDE BARCODE."
        Lbl2.Caption = "NOK"
        GoTo StopFinding
      Else
      If Not Found Is Nothing Then

'string gevonden

       Found.Select
       
 'celkleur niet gevonden
        
      If ActiveCell.Interior.ColorIndex <> 43 Then
        
     MsgBox "kleur niet gevonden"
        
        Found.Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
            .PatternTintAndShade = 0
            Lbl1.Caption = "DE BARCODE IS GEVONDEN." & vbNewLine & vbNewLine & "DRUK OP RESET" & vbNewLine & "SCAN EEN VOLGENDE BARCODE."
            Lbl2.Caption = "OK"
            TxtBarcode1.BackColor = RGB(102, 255, 0)
            End With
       GoTo StopFinding
       End If
              
  'celkleur gevonden
       
      If ActiveCell.Interior.ColorIndex = 43 Then
      MsgBox "kleur gevonden"
      Set Found = .FindNext(Found)
      If Not Found Is Nothing Then 'gevonden
        firstAddress = Found.Address
        Do
        Set Found = .FindNext(Found)
        Found.Select
        MsgBox "volgende gevonden"
        If ActiveCell.Interior.ColorIndex <> 43 Then GoTo KleurGevonden
       
        Loop While Not Found Is Nothing And ActiveCell.Interior.ColorIndex <> 43
      End If
      End If
      
    'volgende geen kleur
KleurGevonden:
        If ActiveCell.Interior.ColorIndex <> 43 Then
        MsgBox "kleur niet gevonden"
        
        Found.Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
            .PatternTintAndShade = 0
            Lbl1.Caption = "DE BARCODE IS GEVONDEN." & vbNewLine & vbNewLine & "DRUK OP RESET" & vbNewLine & "SCAN EEN VOLGENDE BARCODE."
            Lbl2.Caption = "OK"
            TxtBarcode1.BackColor = RGB(102, 255, 0)
            End With
       GoTo StopFinding
       End If

StopFinding:

End If
End If
End With
End Sub

VenA · 23 apr 2018

Wat wil je nu precies bereiken/controleren? Een barcode mag maar 1 keer per dag voorkomen en anders een kleurtje of als deze al een kleurtje heeft dan is het geaccordeerd en mag je op dezelfde dag toch weer dezelfde barcode scannen? De code is qua structuur totaal onleesbaar. Als je wilt voorkomen dat 2x dezelfde barcode achter elkaar gescand wordt dat kan je toch eenvoudig checken of de laatste scan overeenkomt met het laatste opgeslagen record.?

Killerclown · 23 apr 2018

VenA zei:
Wat wil je nu precies bereiken/controleren? Een barcode mag maar 1 keer per dag voorkomen en anders een kleurtje of als deze al een kleurtje heeft dan is het geaccordeerd en mag je op dezelfde dag toch weer dezelfde barcode scannen? De code is qua structuur totaal onleesbaar. Als je wilt voorkomen dat 2x dezelfde barcode achter elkaar gescand wordt dat kan je toch eenvoudig checken of de laatste scan overeenkomt met het laatste opgeslagen record.?

Mijn excuses dat het niet zo duidelijk is.
Dat is door mijn amateuristisch geknoei :-s

Dit is eigenlijk de bedoeling:

- Men scant een barcode en die moet gezocht worden binnen dezelfde dag (vandaar mijn range-bepaling)
- Een barcode kan niet of 1 of meerdere keren voorkomen binnen 1 dag.

Situatie A: de barcode komt niet voor binnen de dag
=> bericht op scherm
Dit werkt in mijn opzet

Situatie B: de barcode komt 1 keer voor binnen de dag
=> cel wordt gekleurd en bericht op scherm
Dit werkte ook in mijn opzet

Situatie C: De barcode komt een 2e keer voor (bij een 2de scanning)
Hier loop ik vast en geraak ik er niet meer aan uit.
Dit is hetgeen zou moeten gebeuren:

- dezelfde barcode wordt gescand => check of de cel een kleur heeft (dwz dat de barcode al eens gescand is)
- als de cel een kleur heeft (en dus al eens gescand is) dan moet de code gaan zoeken of binnen die dag nog zo'n barcode voorkomt.
- Komt de barcode niet meer voor, dan verschijnt er een bericht op scherm
- komt de barcode wel voor en de cel is niet gekleurd, dan moet de cel ook de kleur krijgen en de code stop met zoeken.
- Komt de barcode voor en de cel is gekleurd dan moet hij verder zoeken naar de volgende zelfde barcode die dan weer met of zonder kleur is en deze dan weer wel of niet kleuren. (dat zou mijn loop zijn, maar deze lukt ook niet)

Zo moet ik dan een blad met verschillende barcodes kunnen inscannen die dan automatisch controleert of deze voorkomen in Excel.

Ik dacht dit snel te maken maar rij mij eindeloos vast en ik wou dit vorige week al in gebruik nemen.

VenA · 23 apr 2018

- Een barcode kan niet of 1 of meerdere keren voorkomen binnen 1 dag.

Ben hier al afgehaakt.

Killerclown · 24 apr 2018

VenA zei:
Ben hier al afgehaakt.

Dat zijn de 3 situaties die kunnen voorkomen.

Mijn code werkt behalve als de barcode reeds gescand is en dus de cel een kleur heeft. Dan moet hij de volgende zoeken en daar stoppen maar dat lukt niet. De code zoekt de volgende niet en ik zie niet waarom.

HSV · 24 apr 2018

Zo zet je een 'do while loop' op.

Code:

Private Sub StringBB()
Dim c As Range, firstaddress As String
  With TxtBarcode1
  If .Value <> "" Then
   Set c = Columns(3).Find(.Value, , , xlWhole)
   If Not c Is Nothing Then
    firstaddress = c.Address
    Do
      If c.Interior.Color = vbWhite Then
        c.Interior.Color = vbYellow
        Y = Y + 1
      End If
      Set c = Columns(3).FindNext(c)
    Loop While Y <> 2 And Not c Is Nothing And c.Address <> firstaddress
   End If
   End If
End With
Set c = Nothing
End Sub

Killerclown · 13 mei 2018

Bedankt voor de reacties. Het is mij uiteindelijk gelukt en de code doet wat ik wil.
Hieronder een voorbeeld wat het geworden is.
Waarschijnlijk kan dit nog korter geschreven worden maar voor mij als leek werkt het en dat is het voornaamste

Code:

Private Sub StringB1()

    Dim MyYear
    Dim MyDate
    MyYear = Left(TxtDatum, 4) & ""
    MyDate = TxtDatum.Value

    Dim Found As Range
    Dim strB As String
    Dim firstAddress As String
    Dim C As Range
    Dim WhereFirst As Range
    Dim WhereLast As Range
    Dim whatt As String
    Dim RowLast As Integer
    Dim RowFirst As Integer

'BEPAAL DE RANGE (= DEZELFDE DAG)

    whatt = MyDate
    Set C = Range("A:A")
    Set WhereLast = C.Find(What:=whatt, After:=C(1), SearchDirection:=xlPrevious)
    
    If WhereLast Is Nothing Then
    MsgBox "Deze datum is niet gevonden"
    Exit Sub
    Else
    RowLast = Mid(WhereLast.Address(0, 0), 2)
    Set WhereFirst = C.Find(What:=whatt, After:=C(1))
    RowFirst = Mid(WhereFirst.Address(0, 0), 2)
    End If
      
'ZOEK STRING B

    strB = Mid(TxtBarcode1.Value, 2, 13) & "00"         

    With Worksheets(MyYear).Range("C" & RowFirst, "C" & RowLast)
    Set Found = .Find(strB)

'STRING NIET GEVONDEN

    If Found Is Nothing Then
        TxtBarcode1.BackColor = RGB(204, 51, 0)             
        Lbl1.Caption = "DE BARCODE IS NIET GEVONDEN."       
        GoTo StopFinding
    Else
    If Not Found Is Nothing Then

'STRING GEVONDEN, GA NAAR CELKLEUR

    Found.Select
    End If
       
'CELKLEUR NIET GEVONDEN
        
    If ActiveCell.Interior.Color <> vbGreen Then
    'MsgBox "kleur niet gevonden"
        
        Found.Select
            With Selection.Interior
            .Color = vbGreen
            Lbl1.Caption = "DE BARCODE IS GEVONDEN."        
            TxtBarcode1.BackColor = RGB(102, 255, 0)        
            End With
        GoTo StopFinding
        End If
              
'CELKLEUR GEVONDEN
       
    If ActiveCell.Interior.Color = vbGreen Then 'KLEUR GEVONDEN, ZOEK VOLGENDE
    'MsgBox "kleur gevonden"
      
    If Not Found Is Nothing Then  'WAARDE GEVONDEN
        firstAddress = Found.Address
        Do
        Set Found = .FindNext(Found) 'ZOEK VOLGENDE
        Found.Select
        TxtBarcode1.BackColor = RGB(204, 51, 0)             
        Lbl1.Caption = "DE BARCODE IS NIET GEVONDEN OF REEDS GESCAND."  
        Loop While Not Found Is Nothing And Found.Interior.Color = vbGreen And firstAddress <> Found.Address
        End If
        End If

    If ActiveCell.Interior.Color <> vbGreen Then    'KLEUR NIET GEVONDEN, KLEUR DE CEL
    'MsgBox "kleur niet gevonden"
        Found.Select
        With Selection.Interior
            .Color = vbGreen
            Lbl1.Caption = "DE BARCODE IS GEVONDEN."        
            TxtBarcode1.BackColor = RGB(102, 255, 0)        
        End With
        GoTo StopFinding
        End If

StopFinding:

'GA NAAR VOLGENDE BARCODE

    If TxtBarcode2.Value = "" Then                 
    Exit Sub
    End If
    
    If TxtBarcode2.Value Like "=B*" Then           
    ActiveSheet.Range("C2").Select
    Call StringB2                                  
    
    ElseIf TxtBarcode2.Value Like "=<E*" Then      
    ActiveSheet.Range("D2").Select
    Call StringE2                                  
    
    Else
    MsgBox ("Gelieve een barcode in te scannen die begint met een B of een E.")
    Lbl2.Caption = "VERKEERDE BARCODE"              
    TxtBarcode2.BackColor = RGB(204, 51, 0)         
    
        If TxtBarcode3.Value Like "=B*" Then        
        ActiveSheet.Range("C2").Select
        Call StringB3                               
    
        ElseIf TxtBarcode3.Value Like "=<E*" Then   
        ActiveSheet.Range("D2").Select
        Call StringE3                               
    
    End If
    End If
    End If
    
End With

End Sub

HSV · 13 mei 2018

Je kan beter geen vragen stellen;
Je doet verrekt weinig met de antwoorden.

De found hoef je niet meer selecteren om met select verder te gaan.
Bekijk mijn code en de uwe.
Dan leer je tenminste toch nog iets vandaag.

Barcode zoeken

Killerclown

Gebruiker

VenA

Inventaris

HSV

Inventaris

Killerclown

Gebruiker

HSV

Inventaris

Killerclown

Gebruiker

VenA

Inventaris

Killerclown

Gebruiker

VenA

Inventaris

Killerclown

Gebruiker

HSV

Inventaris

Killerclown

Gebruiker

HSV

Inventaris

Nieuwste berichten

Wij waarderen jouw privacy