voorwaardelijke msgbox excel

Status
Niet open voor verdere reacties.
M

maomanna

Gebruiker
Lid geworden
20 feb 2014
Berichten
234
ik heb een excelbestand waarbij ik op basis van een celwaarde, een msgbox wil met daarin informatie.
Nu is een msgbox niet zo spannend

Indien in een cel in de kolom G een waarde <= 7 bevat, moet er een msgbox komen met daarin de informatie uit de cellen A, B en C vanuit dezelfde regel.

Voor het gemak en idee, een voorbeeldbestand.
Bekijk bijlage voorbeeld.zip

ik denk wel dat er nog een controle cel bij moet komen, anders blijf je bij de bovenste hangen.
in H zou dan een X moeten komen als deze msgbox is geweest.
 
Laatst bewerkt:
Zoiets?
Als er in Kolom H een X staat wordt de rij niet meer meegenomen in de code
 

Bijlagen

  • voorbeeld.xlsm
    22,1 KB · Weergaven: 54
Waarom niet gewoon met het autofilter?

Code: 
Sub VenA()
  Cells(1).CurrentRegion.AutoFilter 7, "<=7"
End Sub

Of 1 berichtbox die alles weergeeft
Code: 
Sub VenA1()
ar = Cells(1).CurrentRegion
For j = 2 To UBound(ar)
  If ar(j, 7) <= 7 Then c00 = c00 & "#Rij" & j & "_" & ar(j, 1) & "_" & ar(j, 2) & "_" & ar(j, 3) & Chr(10)
Next j
MsgBox c00
End Sub
 
Met nog even de controle voor een volgende uitvoer.
Code: 
Sub controle()
ar = Cells(1).CurrentRegion.columns(1).resize(, 8)
For i = 2 To UBound(ar)
  If ar(i, 7) < 8 and ar(i, 8) = "" then
     c00 = c00 & "#Rij" & i & "_" & ar(i, 1) & "_" & ar(i, 2) & "_" & ar(i, 3) & vblf
     ar(i, 8) ="x"
   end if
  Next i
 if len(c00) > 0 then MsgBox c00
cells(1).resize(ubound(ar), ubound(ar,2)) = ar
End Sub
 
dank jullie allen!
alle drie werken ze prima!
Het is alleen nog even de vraag wat het makkelijkst is, per regel 1 msgbox of alles in 1.
Bij een per msgbox, kan nog een inputbox worden gekoppeld aan een knop "OK" bijv. die dan wegschrijft naar kolom I (status bijv).
De info uit kolom I kan dan ook worden weergegeven in de msgbox. Dan heb je alles bijeen.

Het doel is, om alles op tijd over te dragen. de msgbox moet actief sturen wat voor wie gedaan moet worden.

@VenA, helaas kan autofilter niet omdat het onjuistheden gaat genereren omdat het een gedeeld bestand is. Op verschillende plekken worden cellen gemuteerd.

Edit:
heb ipv X nu een timestamp toegevoegd,
Het principe bij Dotchie is hetzelfde.

Code: 
Private Sub CommandButton1_Click()
ar = Cells(1).CurrentRegion.Columns(1).Resize(, 8)
For i = 2 To UBound(ar)
  If ar(i, 7) < 8 And ar(i, 8) <= Now Then
     c00 = c00 & "#Rij" & i & "_" & ar(i, 1) & "_" & ar(i, 2) & "_" & ar(i, 3) & vbLf
     ar(i, 8) = Now
   End If
  Next i
 If Len(c00) > 0 Then MsgBox c00
Cells(1).Resize(UBound(ar), UBound(ar, 2)) = ar
End Sub

of
Code: 
Private Sub CommandButton2_Click()
 With ActiveSheet
        Set rngColG = .Range(.Cells(2, 7), .Cells(.Rows.Count, 7).End(xlUp))
        For Each rngCell In rngColG.Cells
        If rngCell.Value <= 7 And rngCell.Offset(, 1).Value <= Now Then
        MsgBox "Waarden zijn: " & rngCell.Offset(, -6).Value & "-" & rngCell.Offset(, -5).Value _
        & "-" & rngCell.Offset(, -4).Value & " over " & rngCell.Offset & " dagen ", vbInformation, "Info"
        rngCell.Offset(, 1).Value = Now
        End If
        Next
        End With
End Sub

nu nog opzoek naar de inputbox

Bekijk bijlage voorbeeld.xlsm

edit2

Met de onderstaande optie geeft hij aan dat hij buiten bereik is.
Wel komt na de msgbox Yes de inputbox.

Code: 
Private Sub CommandButton1_Click()
ar = Cells(1).CurrentRegion.Columns(1).Resize(, 9)
For i = 2 To UBound(ar)
  If ar(i, 7) < 8 And ar(i, 8) <= Now Then
     c00 = c00 & "#Rij" & i & "_" & ar(i, 1) & "_" & ar(i, 2) & "_" & ar(i, 3) & vbLf
     ar(i, 8) = Now
   End If
  Next i
 If Len(c00) > 0 Then MsgBox c00, vbYesNo
Cells(1).Resize(UBound(ar), UBound(ar, 2)) = ar

If vbYes Then
Dim myValue As Variant

myValue = InputBox("Geef aan wat de laatste status is", "Statuswijziging", 1)
ar(i, 9) = myValue
Else
    'do nothing
End If
End Sub


edit3:
Code: 
Private Sub CommandButton2_Click()
 With ActiveSheet
        Set rngColG = .Range(.Cells(2, 7), .Cells(.Rows.Count, 7).End(xlUp))
        For Each rngCell In rngColG.Cells
        If rngCell.Value <= 7 And rngCell.Offset(, 1).Value <= Now Then
        MsgBox "Het dossier van " & rngCell.Offset(, -6).Value & " " & rngCell.Offset(, -5).Value _
        & " " & rngCell.Offset(, -4).Value & " moet over " & rngCell.Offset & " dagen worden overgedragen.", vbYesNo, "Info"
        rngCell.Offset(, 1).Value = Now
        If vbYes Then
Dim myValue As Variant

myValue = InputBox("Geef aan wat de laatste status is", "Statuswijziging", 1)
rngCell.Offset(, 2).Value = myValue
Else
    'do nothing
End If
        
        End If
        Next
        End With
End Sub
Hiermee lijk ik er te zijn.

Edit 4:

toch nog niet.

In de formule in kolom G, kan ook "x" voorkomen.
Nu loopt hij daarop vast omdat het type niet overeenkomt.

dan moet er een extra And bij
Code: 
        If rngCell.Value <= 7 And rngCell.Value <> "x" And rngCell.Offset(, 1).Value <= Now Then
dit werkt niet.
 
Laatst bewerkt:
Je zou het bestand kunnen plaatsen met de vraag wat er moet gebeuren.
Door al die aanpassingen heb ik geen behoefte om het vorig bestand in te zien en te bewerken..
 
begrijpelijk.

Hierbij het recente bestand.
Bekijk bijlage voorbeeld laatste.xlsm

Als er een X in kolom G staat, dan overslaan.

daarbij klopt de formule van x ook niet.
Code: 
=ALS(SOM(ALS(E5="x";"x";DATUMVERSCHIL(VANDAAG();E5;"d"))-2)=-2;x;(ALS(E5="x";"x";DATUMVERSCHIL(VANDAAG();E5;"d"))))

Hiermee wil ik bepalen dat als in E een "x" staat, een X in kolom G komt.
Staat er een datum, dan het aantal dagen tussen E en kolom F -2.
is de uitkomst #getal of #waarde, dan moet er eigenlijk een negatief getal uit komen, zodat de msgbox deze ook oppikt.


Edit:
dit hieronder is opgelost
De optie voor een EsleIF toegevoegd voor als de waarde 0 of lager is.
De volgorde van msgboxxen kloppen dan niet meer.
Hij geeft eerst alles weer en daarna pas komt pas de inputbox voor de laatste record.
 
Laatst bewerkt:
Inmiddels ook het X of datum in het verleden opgelost.

Code: 
=ALS(E7="x";-3;ALS(E7<VANDAAG();-3;SOM(ALS(E6="x";"";DATUMVERSCHIL(VANDAAG();E6;"d"))-2)))

Voor degene die dan ook voorwaardelijke msgboxxen en input wil, hierbij de complete code:

Code: 
Private Sub CommandButton2_Click()
Dim myValue As Variant
Dim myValue2 As Date
Dim answer As Integer
 With ActiveSheet
        Set rngColG = .Range(.Cells(2, 7), .Cells(.Rows.Count, 7).End(xlUp))
        For Each rngCell In rngColG.Cells
        If rngCell.Value <= 7 And rngCell.Value > 1 And rngCell.Value <> "x" And rngCell.Offset(, 1).Value <= Now Then
        answer = MsgBox("Klopt het dat het dossier van " & rngCell.Offset(, -6).Value & " " & rngCell.Offset(, -5).Value _
        & " " & rngCell.Offset(, -4).Value & " over " & rngCell.Offset & " dagen moet worden overgedragen?", vbYesNo, "Info")
        rngCell.Offset(, 1).Value = Now
            If answer = vbYes Then
                myValue = InputBox("Geef aan wat de laatste status is", "Statuswijziging", 1)
                rngCell.Offset(, 2).Value = myValue
            ElseIf answer = vbNo Then
                myValue2 = InputBox("Geef aan wat de juiste inschrijfdatum is", "Wijziging inschrijfdatum", 1)
                rngCell.Offset(, -2).Value = myValue2
            End If
        ElseIf rngCell.Value = 0 Then
        answer = MsgBox("Het dossier van " & rngCell.Offset(, -6).Value & " " & rngCell.Offset(, -5).Value _
        & " " & rngCell.Offset(, -4).Value & " moet vandaag worden overgedragen.", vbYesNo, "Info")
        rngCell.Offset(, 1).Value = Now
            If answer = vbYes Then
                myValue = InputBox("Geef aan wat de laatste status is", "Statuswijziging", 1)
                rngCell.Offset(, 2).Value = myValue
            ElseIf answer = vbNo Then
                myValue2 = InputBox("Geef aan wat de juiste inschrijfdatum is", "Wijziging inschrijfdatum", 1)
                rngCell.Offset(, -2).Value = myValue2
            End If
        ElseIf rngCell.Value < 0 And rngCell.Value = "-1" Then
        answer = MsgBox("De inschrijving van " & rngCell.Offset(, -6).Value & " " & rngCell.Offset(, -5).Value _
        & " " & rngCell.Offset(, -4).Value & " is morgen. Klopt dit?.", vbYesNo, "Klopt de datum?")
        rngCell.Offset(, 1).Value = Now
            If answer = vbYes Then
                'Do Nothing
            ElseIf answer = vbNo Then
                myValue2 = InputBox("Geef aan wat de juiste inschrijfdatum is", "Wijzig inschrijfdatum", 1)
                rngCell.Offset(, -2).Value = myValue2
            End If
        ElseIf rngCell.Value = -2 Then
        answer = MsgBox("De inschrijving van " & rngCell.Offset(, -6).Value & " " & rngCell.Offset(, -5).Value _
        & " " & rngCell.Offset(, -4).Value & " is vandaag. Klopt dit?.", vbYesNo, "Klopt de datum?")
        rngCell.Offset(, 1).Value = Now
            If answer = vbYes Then
                MsgBox "Schoon de lijst op.", vbOKOnly
            ElseIf answer = vbCancel Then
                myValue2 = InputBox("Geef aan wat de juiste inschrijfdatum is", "Wijzig inschrijfdatum", 1)
                rngCell.Offset(, -2).Value = myValue2
            End If
        ElseIf rngCell.Value = -3 Then
        answer = MsgBox("De datum van inschrijving voor " & rngCell.Offset(, -6).Value & " " & rngCell.Offset(, -5).Value _
        & " " & rngCell.Offset(, -4).Value & " klopt niet. Of er is niet opgeschoond. Klopt dit? Voor opschonen klik Ja, voor datum aanpassen klik Nee", vbYesNo, "Klopt de datum?")
        rngCell.Offset(, 1).Value = Now
            If answer = vbYes Then
                MsgBox "Schoon de lijst op.", vbOKOnly
            ElseIf answer = vbNo Then
                myValue2 = InputBox("Geef aan wat de juiste inschrijfdatum is", "Wijzig inschrijfdatum", 1)
                rngCell.Offset(, -2).Value = myValue2
            End If
        End If
        Next
        End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan