MessageBox toevoegen aan code

[SBryony]

Hi, Wie kan mij helpen??

Ik heb een code die prima werkt (wanneer iemand 'gereed' kiest, verdwijnt de regel naar een andere tab).

Private Sub Worksheet_Change(ByVal Target As Range) 'De code start bij een wijziging
If Target.Column <> 8 Then Exit Sub 'Als de wijziging niet in kolom H gebeurt dan STOP
If Target.Value = "Gereed" Then 'Als in kolom H "Gereed" staat dan
ActiveCell.EntireRow.Cut Destination:=Sheets("Digitale werkbak").[A65536].End(xlUp).Offset(1, 0) 'Zet de tekst in de laatste lege regel van blad2
ActiveCell.EntireRow.Delete 'De overgezette regel wordt in blad1 verwijderd
Sheets("Afgehandeld").Columns("A:S").AutoFit 'Pas in Afgehandeld de kolombreedte aan, aan de tekst
MsgBox ("De regel is overgezet")
End If
End Sub

Echter wil ik dat voordat hij verdwijnt ze een message box krijgen (bijv. een Yes or No), waarmee ze de actie moeten verifieren.
Bij Yes, wordt de code uitgevoerd. Bij No, stopt hij en blijft de vorige status dus onveranderd.

Iemand enig idee?

 

[VenA]

Bv zo

If MsgBox("zeker weten?", vbYesNo) = vbNo Then Exit Sub

 

[gast0660]

Hoi, welkom op het forum
Plaats in het vervolg uw code tussen code tags.

Zoiets?

Dim smessage As String

  smessage = "Regel overzetten, ben je zeker" + "?"
    If MsgBox(smessage, vbQuestion + vbYesNo, _
              "Bevestig overzetten") = vbNo Then
	Exit Sub
Else

 

[SBryony]

Bedankt! Vervolg vraag hierop..

Hoi, welkom op het forum
Plaats in het vervolg uw code tussen code tags.

Zoiets?

Dim smessage As String

  smessage = "Regel overzetten, ben je zeker" + "?"
    If MsgBox(smessage, vbQuestion + vbYesNo, _
              "Bevestig overzetten") = vbNo Then
	Exit Sub
Else

Bv zo

If MsgBox("zeker weten?", vbYesNo) = vbNo Then Exit Sub

Beide super bedankt voor jullie reactie! Het heeft geholpen.
Een vervolgvraag hierop:
Ik heb nu erin staan dat als ze de status 'Gereed' kiezen de regel word overgezet naar een andere tab.
Ik zou graag willen dat als ze de status 'Wacht op uitrol kantoor' kiezen de regel ook word overgezet naar een andere tab hiervoor.

Merkte dat ik niet simpelweg dezelfde code kon dupliceren.. Ik krijg dan compile error: Block if without End if.. Wat moet ik doen om dit te laten werken? Alvast bedankt!

 

[gast0660]

Voor uw eerste vraag:

Dim smessage As String

  smessage = "Regel overzetten, ben je zeker" + "?"
    If MsgBox(smessage, vbQuestion + vbYesNo, _
              "Bevestig overzetten") = vbNo Then
	Exit Sub
Else
[COLOR="#FF0000"]End if[/COLOR]

 

[VenA]

Heb je er even een voorbeeldbestandje bij? Ik begrijp niet helemaal wat de bedoeling van de code is. Activecell is normaal gesproken de cel onder de target cel. Je gaat de gegevens verplaatsen naar het blad 'Digitale werkbak' en de kolombreedte van het blad 'Afgehandeld' ga je aanpassen?

Mogelijk dat je zoiets bedoelt.

Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ar
If Target.Column <> 8 Then Exit Sub
ar = Array("Gereed", "Wacht op uitrol kantoor", "Digitale werkbak", "Wacht op uitrol kantoor")
  Application.EnableEvents = False
  With Target
    If .Value = "Gereed" Or .Value = "Wacht op uitrol kantoor" Then
      If MsgBox("zeker weten?", vbYesNo) = vbNo Then Exit Sub
        .EntireRow.Cut Sheets(ar(Application.Match(Target.Value, ar, 0) + 2)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .EntireRow.Delete
        Columns("A:S").AutoFit
    End If
  End With
  Application.EnableEvents = True
End Sub

 

[SBryony]

Heb je er even een voorbeeldbestandje bij? Ik begrijp niet helemaal wat de bedoeling van de code is. Activecell is normaal gesproken de cel onder de target cel. Je gaat de gegevens verplaatsen naar het blad 'Digitale werkbak' en de kolombreedte van het blad 'Afgehandeld' ga je aanpassen?

Mogelijk dat je zoiets bedoelt.

Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ar
If Target.Column <> 8 Then Exit Sub
ar = Array("Gereed", "Wacht op uitrol kantoor", "Digitale werkbak", "Wacht op uitrol kantoor")
  Application.EnableEvents = False
  With Target
    If .Value = "Gereed" Or .Value = "Wacht op uitrol kantoor" Then
      If MsgBox("zeker weten?", vbYesNo) = vbNo Then Exit Sub
        .EntireRow.Cut Sheets(ar(Application.Match(Target.Value, ar, 0) + 2)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .EntireRow.Delete
        Columns("A:S").AutoFit
    End If
  End With
  Application.EnableEvents = True
End Sub

Hoi @VenA,

Bekijk bijlage Voorbeeldbestand SB 20161101 - Copy.xlsm
Zie bijlage.
Op dit moment als ze bij status dossier kiezen voor 'Gereed', dan kunnen ze deze bevestigen en wordt de regel verplaatst naar de tab 'Afgehandeld'.

Wat ik graag zou willen, is dat als ze straks kiezen voor de status 'Wacht op uitrol kantoor', dat deze ook moeten bevestigen en dat de regel wordt verplaatst naar de tab 'Wacht op uitrol'.

Dus beide opties/acties in 1 sheet

 

[VenA]

Wil svp niet onnodig quoten?

Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ar, c00 As String
If Target.Column <> 7 Then Exit Sub
ar = Array("Gereed", "Wacht op uitrol kantoor", "Afgehandeld", "Wacht op Uitrol")
  Application.EnableEvents = False
  With Target
    If .Value = "Gereed" Or .Value = "Wacht op uitrol kantoor" Then
      If MsgBox("Review gereed melden?", vbYesNo) = vbNo Then Exit Sub
        c00 = ar(Application.Match(Target.Value, ar, 0) + 2)
        .EntireRow.Cut Sheets(c00).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .EntireRow.Delete
        Sheets(c00).Columns("A:S").AutoFit
    End If
  End With
  Application.EnableEvents = True
End Sub

 

[SBryony]

excuus!

En super bedankt, dit werkt prima voor mij

Vriendelijke groet!

 

[SBryony]

Oh oeps.. ik zie 1 dingetje nog...

De cel verplaatst hij inderdaad naar de juiste tab nu, echter in de tab vanuit waar hij hem verplaatst blijft een lege rij achter.
Hoe ziet de code eruit als ik wil dat dit niet gebeurd? Er moeten dus geen lege rijen tussen de overige rijen verschijnen..

 

[VenA]

Bij mij wordt de rij verwijderd en blijft er dus geen lege rij over. Daar zorgt deze regel voor

.EntireRow.Delete