Msgbox

[Eggie]

Hallo,

ik heb een vba script geschreven zodat er een msgbox verschijnt wanneer er in kolom x een bepaalde waarde wordt ingevuld. weet niet of het script logisch is (waarschijnlijk kan het veel makkelijker maar t werkt wel ;-s).

Nu wil ik alleen dat wanneer er bijvoorbeel 5 regel tegelijk in de sheet worden geplakt met de waarde waarbij de msg box verschijnt, deze maar 1 maal wordt getoond.

Op dit moment werkt het script wel als er regel voor regel wordt ingevoerd..

Het script is:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngchange As Range
Dim rngEDI As Range

Set rngchange = Intersect(Target, Columns(7))
If Not rngchange Is Nothing Then
For Each rngEDI In rngchange
If Not IsEmpty(rngEDI) Then
If rngEDI.Column = 7 Then
If rngchange = "Problem With EDI" Then
rngEDI.Select
Selection.Offset(0, 2).Select
ActiveCell = MsgBox("Vul hier a.u.b. het Call ID in")

    End If
    End If
    End If
    Next rngEDI
    End If

Alvast bedankt voor de hulp!

Groeten Eggie

 

[Wigi]

Ik denk dat het zo kan, is wel ongeteste code

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngchange As Range
    Dim rngEDI As Range
    Dim lKleur As Long
    
    Set rngchange = Intersect(Target, Cells.Columns(7))
    
    If Not rngchange Is Nothing Then
        For Each rngEDI In rngchange
            If Not IsEmpty(rngEDI) Then
                If rngEDI.Value = "Problem With EDI" Then
                    With rngEDI.Offset(0, 2)
                        lKleur = .Interior.ColorIndex
                        .Interior.ColorIndex = 3
                        .Select
                        .Value = Application.InputBox("Vul hier a.u.b. het Call ID in", "Call ID", Type:=1)
                        .Interior.ColorIndex = lKleur
                    End With
                End If
            End If
        Next rngEDI
    End If
End Sub

Wigi

 

[Eggie]

Hallo wigi,

bedank voor je snelle reactie. Ben nu een stap verder, geen foutmelding bji het plakken van meerdere regels.

Nog 1 klein vraagje,

als er nu bijvoorbeeld 5 regels worden toegevoegd met de waarde "problem with EDI",
dan zou ik graag een input venster willen waarin maar 1 keer het ID hoeft te worden ingegeven voor de hele selectie.
Het gaat vaak om +100 regels waarvor hetzelfde ID geld, dus dan is t wat veel werk als dat +100 keer moet worden ingetikt...

Hoop dat je me hiermee ook nog kan helpen, alvast bedankt!!!!

Groeten Eggie

 

[Wigi]

Minder lussen, weer ongetest

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngchange As Range
    Dim rGewijzCellen As Range
    
    Set rngchange = Intersect(Target, Cells.Columns(7))
    
    If Not rngchange Is Nothing Then
        On Error Resume Next
        Set rGewijzCellen = rngchange.SpecialCells(xlCellTypeConstants, 2)
        On Error GoTo 0
        
        If Not rGewijzCellen Is Nothing Then
            With rGewijzCellen
                .Select
                .Value = Application.InputBox("Vul hier a.u.b. het Call ID in", "Call ID", Type:=1)
            End With
        End If
    End If
End Sub

Wigi

 

[Eggie]

wigi,

dit gaat niet helemaal goed ;-).

Nu wordt bij elke ingave om het Call ID gevraag, maar dit moet alleen waneer de waarde in kolom 7 "Problem with EDI" is... Daarnaast wordt de waarde die in de inputbox wordt ingevoerd overschreven in kolom 7 terwijl dit 9 moet zijn (offset 0,2)

De code is voor mij nu iets te ingewikkeld geworden om dit zelf op te lossen...dus hoop dat je er nog heel ff naar kan kijken....

Dus als waarde in kolom 7 = "problem with EDI" dan twee kolommen verder (offset 0,2) een inputbox met call ID.
Als er meerdere regels worden geplakt dan voor die selectie 1 * een inputbox en het call ID dat dan wordt ingevuld moet voor alle geplakte (geselecteerde) cellen in kolom 9 worden ingevoerd...

Vrij complex dus, alvast bedankt weer voor feedback!

Groeten Eggie

 

[Wigi]

Zo dan

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngchange As Range
    Dim rGewijzCellen As Range
    Dim r As Range
    Dim IDnumb As Integer
    
    Set rngchange = Intersect(Target, Cells.Columns(7))
    
    If Not rngchange Is Nothing Then
        On Error Resume Next
        Set rGewijzCellen = rngchange.SpecialCells(xlCellTypeConstants, 2)
        On Error GoTo 0
        
        If Not rGewijzCellen Is Nothing Then
            
            If WorksheetFunction.CountIf(rGewijzCellen, "problem with EDI") > 0 Then
                IDnumb = Application.InputBox("Vul hier a.u.b. het Call ID in", "Call ID", Type:=1)
            
                For Each r In rGewijzCellen
                    If r.Value = "problem with EDI" Then
                        r.Select
                        r.Offset(, 2).Value = IDnumb
                    End If
                Next
            End If
        End If
    End If
End Sub

Wigi

 

[Eggie]

wigi,

nu zit er een error in de code, bij elke invoer in kolom 7 het volgende:

Run-time error 1004

Unable to get the countif property of the WorksheetFunction class.

Enig idee wat er niet klopt aan de countif functie?? Ik zie er geen fout in eigenlijk...

Nog een idee hoe dit op te lossen??

Thanks, Eggie

 

[Wigi]

Neen, niet echt. Hang eens een voorbeeldbestandje bij aub.

 

[Eggie]

mm, lastig, het bestand is erg eenvoudig...
Gewoon een sheet (zonder functies o.i.d.)...

Zal een voorbeeld sturen maar voegt vanwege de eenvoud weinig toe ben ik bang, misschien helpt het bij de beeldvorming...

Korte toelichting nog in de bijlage..

Thanks!!!!!

 

[Wigi]

Met de syntax van de CountIf functie is niets mis, maar wel het feit dat dit niet werkt voor een zoekbereik dat bestaat uit niet-aaneengesloten cellen. Je zal dus iets anders moeten vinden.

 

[Wigi]

Zo denk ik:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngchange As Range
    Dim rGewijzCellen As Range
    Dim r As Range
    Dim rng As Range
    Dim IDnumb As Integer
    
    Set rngchange = Intersect(Target, Cells.Columns(7))
    
    If Not rngchange Is Nothing Then
        On Error Resume Next
        Set rGewijzCellen = rngchange.SpecialCells(xlCellTypeConstants, 2)
        On Error GoTo 0
        
        If Not rGewijzCellen Is Nothing Then
            
            On Error Resume Next
            rng = rGewijzCellen.Find(what:="problem with EDI", LookIn:=xlValues, lookat:=xlPart)
            On Error GoTo 0
            
            If Not rng Is Nothing Then
                IDnumb = Application.InputBox("Vul hier a.u.b. het Call ID in", "Call ID", Type:=1)
                For Each r In rGewijzCellen
                    If r.Value = "problem with EDI" Then
                        r.Select
                        r.Offset(, 2).Value = IDnumb
                    End If
                Next
            End If
        End If
    End If
End Sub

Ik heb de Find functie gebruikt. Wordt er niets gevonden, dan moet je ook niets ingeven in de inputbox.

Wigi

 

[Eggie]

Hallo Wigi,

heb de code gisteren en vandaag geprobeerd maar bij mij doet deze het niet

Weet niet wat ik fout doe maar wanneer ik problem with EDI en kolom G typ verschijnt er geen inputbox (ook copy paste van "problem with EDI" werkt niet)...

De eerste vba code van gisteren werkte wel alleen was daar dus het probleem dat er voor elke regel met "problem with EDI" een inputbox verscheen.

Zou je er misschien nog 1 keer naar willen kijken???

Dank je!!!! Groeten Eggie

 

[Wigi]

Merde

Dit

rng = rGewijzCellen.Find(what:=str, LookIn:=xlValues, lookat:=xlPart)

moest dit zijn:

[B]Set[/B] rng = rGewijzCellen.Find(what:=str, LookIn:=xlValues, lookat:=xlPart)

't Zit hem in de kleine dingen... :evil:

Wigi

 

[Eggie]

Thanks

Hallo Wigi, dat was het inderdaad!!

Bedankt voor je hulp!!!!!!!!!