VBA Message box help

[wisemang]

Please be kind as this is first ever post.
I am a total beginner with VBA code and have managed to write the following but struggling to insert a message box at a certain point within the code below :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)



If ActiveCell.Column = 6 Then

Target.Value = ActiveCell.Value

Application.EnableEvents = False

Select Case Target



Case "Pending"
ActiveCell.Value = "Test In Progress"
' icolor = 3
' cel = 1

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192 'red
.TintAndShade = 0
.PatternTintAndShade = 0
End With


Case "Test In Progress"

ActiveCell.Value = "Passed Testing"
' icolor = 40
' cel = 2

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274 'bright green
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Case "Passed Testing"

ActiveCell.Value = "Schedule Live Date"
' icolor = 40
' cel = 2

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407 'orange
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Case "Schedule Live Date"

ActiveCell.Value = "LIVE"
' icolor = 46
' cel = 1

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936 'green
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Case "LIVE"

ActiveCell.Value = "Cancelled"
' icolor = 5
' cel = 1
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10498160 'light green
.TintAndShade = 0
.PatternTintAndShade = 0
End With



Case "Cancelled"

ActiveCell.Value = "Completed"
' icolor = 48
' cel = 1
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255 'White
.TintAndShade = 1
.PatternTintAndShade = 1
End With

Case "Completed"

ActiveCell.Value = "Pending"
' icolor = 40
' cel = 2

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274 'bright green
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Case Else


' Then clear the background
Target.Interior.ColorIndex = xlNone
Target.Value = "Pending"

End Select


Application.EnableEvents = True


' This is to prevent the cell from being edited when double-clicked
Cancel = True

End If

End Sub

What i am trying to do is when the cell gets to 'COMPLETED' i want a message box to pop up to ask ''Do you want to archive this row to Sheet 2'' yes or no.
If yes then removes from sheet 1 and places on sheet 2. If no then reverts back to ''Case Pending''

Many thanks in advance

[mancubus]

hi.
wellcome to VBAX.
pls use green VBA button to display your codes between vba tags.


Current Value.............DoubleClick
Pending.....................Test In Progress
Test In Progress.........Passed Testing
Passed Testing...........Schedule Live Date
Schedule Live Date......LIVE
LIVE..........................Cancelled
Cancelled...................Completed
Completed..................Pending

[vba]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Const msg As String = "Do you want to archive this row to Sheet2?"
Dim iRep As Variant

If Target.Column <> 6 Then Exit Sub

Application.EnableEvents = False

With Target
Select Case .Value
Case "Pending"
.Value = "Test In Progress"
.Interior.Color = 192 'red
Case "Test In Progress"
.Value = "Passed Testing"
.Interior.Color = 5296274 'bright green
Case "Passed Testing"
.Value = "Schedule Live Date"
.Interior.Color = 49407 'orange
Case "Schedule Live Date"
.Value = "LIVE"
.Interior.Color = 5287936 'green
Case "LIVE"
.Value = "Cancelled"
.Interior.Color = 10498160 'light green
Case "Cancelled"
.Value = "Completed"
.Interior.Color = 255 'White
iRep = MsgBox(msg, vbYesNo + vbQuestion, "A R C H I V E ?")
If iRep = vbYes Then
Rows(Target.Row).EntireRow.Copy _
Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Rows(Target.Row).EntireRow.Delete
Else
GoTo dontmove
End If
Case "Completed"
dontmove:
.Value = "Pending"
.Interior.Color = 5296274 'bright green
Case Else
' Then clear the background
.Interior.ColorIndex = xlNone
.Value = "Pending"
End Select
End With

Application.EnableEvents = True

' This is to prevent the cell from being edited when double-clicked
Cancel = True

End Sub
[/vba]

[GTO]

Hi there,

I'm pretty sure I missed the intent by a little after seeing mancubus' solution. Just in case there might not be a value in a particular column, maybe combine this into mancubus' solution to use the .Find method.

[VBA]
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngFoundNonEmptyCell As Range
Dim NextEmptyRow As Long
Dim ActiveCellRow As Long

If ActiveCell.Column = 6 Then

Target.Value = ActiveCell.Value

Application.EnableEvents = False

Select Case Target
Case "Pending"
ActiveCell.Value = "Test In Progress"
' icolor = 3
' cel = 1
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192 'red
' .TintAndShade = 0
' .PatternTintAndShade = 0
End With
Case "Test In Progress"
ActiveCell.Value = "Passed Testing"
' icolor = 40
' cel = 2
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274 'bright green
' .TintAndShade = 0
' .PatternTintAndShade = 0
End With
Case "Passed Testing"

ActiveCell.Value = "Schedule Live Date"
' icolor = 40
' cel = 2
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407 'orange
' .TintAndShade = 0
' .PatternTintAndShade = 0
End With
Case "Schedule Live Date"
ActiveCell.Value = "LIVE"
' icolor = 46
' cel = 1
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936 'green
' .TintAndShade = 0
' .PatternTintAndShade = 0
End With
Case "LIVE"
ActiveCell.Value = "Cancelled"
' icolor = 5
' cel = 1
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10498160 'light green
' .TintAndShade = 0
' .PatternTintAndShade = 0
End With
Case "Cancelled"
ActiveCell.Value = "Completed"
' icolor = 48
' cel = 1
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255 'White
' .TintAndShade = 1
' .PatternTintAndShade = 1
End With
Case "Completed"
If MsgBox("Do you want to archive this row to Sheet 4?", vbYesNo Or vbQuestion, vbNullString) = vbYes Then

With Sheet4 'OR ThisWorkbook.Worksheets ("Sheet4") ---Change to suit
Set rngFoundNonEmptyCell = RangeFound(.Cells)
If Not rngFoundNonEmptyCell Is Nothing Then
NextEmptyRow = rngFoundNonEmptyCell.Row + 1
Else
NextEmptyRow = 2
End If

ActiveCell.EntireRow.Cut .Rows(NextEmptyRow)
ActiveCell.EntireRow.Delete
End With
Else
ActiveCell.Value = "Pending"
' icolor = 40
' cel = 2
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274 'bright green
' .TintAndShade = 0
' .PatternTintAndShade = 0
End With
End If
Case Else
' Then clear the background
Target.Interior.ColorIndex = xlNone
Target.Value = "Pending"
End Select

Application.EnableEvents = True

' This is to prevent the cell from being edited when double-clicked
Cancel = True
End If
End Sub

Private Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
[/VBA]
Hope that helps,

Mark

[GTO]

Please be kind as this is first ever post.
I am a total beginner with VBA code and have managed to write the following but struggling ...

Apologies, for goodness sakes, I forgot to welcome you to the forum .

I am sure you'll have a blast here, welcome to vbaexpress!

Mark

PS. I also forgot to mention tht I REM'd the .TintAndShade etc, just as I don't have it available on the machine I am currently on.

[wisemang]

Hi Mancubus
That works brilliantly...........Thanks for taking the time out and welcoming me to the forum.I am sure i will be back on a regular basis.............Just one more thing what is IREP

[mancubus]

you're wellcome wisemang.

[mancubus]

Hi there,

I'm pretty sure I missed the intent by a little after seeing mancubus' solution. Just in case there might not be a value in a particular column, maybe combine this into mancubus' solution to use the .Find method.

Hope that helps,

Mark

hi Mark.

i assumed those values -kind of status- were already entered.