Solved: Pausing Macro with MsgBox for Input Prompt

[vzachin]

Hi,

I'm copying rows & columns from Sheet1 (M5:P) to Sheet2 (C5). If any of the cells M5,N5,O5 or P5 is empty in Sheet1, I want to pause the macro so that that the user can input the data and then have the macro continue.
How can I write this so that a MsgBox appears telling the user which cell requires data and then have the macro resume?


Sub test2()
Sheets("Sheet1").Select
If Range("M5") = "" Or Range("N5") = "" Or Range("O5") = "" Or Range("P5") = "" Then
MsgBox "Please enter the missing DATA"

With Sheets("Sheet1")
.Range("M5", .Cells(.Rows.Count, "P").End(xlUp)).Copy Sheets("Sheet2").Range("C5")
End With

End If

Sheets("Sheet2").Select
End Sub


thanks
zach

[johnske]

Something like this maybe?
Option Explicit

Sub test2()

Dim Cell As Range

Sheets("Sheet1").Activate
For Each Cell In Range("M5:O5")
If Cell = Empty Then
Cell = InputBox("Please enter the DATA missing from " & Cell.Address(0, 0))
If Cell = Empty Then test2
End If
Next
With Sheets("Sheet1")
.Range("M5", .Cells(.Rows.Count, "P").End(xlUp)).Copy Sheets("Sheet2").Range("C5")
End With
Sheets("Sheet2").Select
End Sub

[vzachin]

hi johnske,

that works great!

is there a way to allow the user to choose to exit the sub instead of filling in the missing data if they want to?
something like entering the word "EXIT" and then have the sub quit.

thanks again
zach

[Bob Phillips]

Sub test2()

Dim Cell As Range

Sheets("Sheet1").Activate
For Each Cell In Range("M5:O5")
If Cell = Empty Then
Cell = InputBox("Please enter the DATA missing from " & Cell.Address(0, 0))
If Cell = Empty Then Exit Sub
End If
Next
With Sheets("Sheet1")
.Range("M5", .Cells(.Rows.Count, "P").End(xlUp)).Copy Sheets("Sheet2").Range("C5")
End With
Sheets("Sheet2").Select
End Sub


and use the Cancel button

[ALe]

taken from microsoft.

Sub Using_InputBox_Function()
Dim Show_Box As Boolean
Dim Response As Variant
' Set the Show_Dialog variable to True.
Show_Box = True
' Begin While loop.
While Show_Box = True
' Show the input box.
Response = InputBox("Enter a number.", _
"Number Entry", , 250, 75)
' See if Cancel was pressed.
If Response = "" Then
' If Cancel was pressed,
' break out of the loop.
Show_Box = False
Else
' Test Entry to find out if it is numeric.
If IsNumeric(Response) = True Then
' Write the number to the first
' cell in the first sheet in the active
' workbook.
Worksheets(1).Range("a1").Value = Response
Show_Box = False
Else
' If the entry was wrong, show an error message.
MsgBox "Please Enter Numbers Only"
End If
End If
' End the While loop.
Wend
End Sub

you can stop if user press Exit or if nothing is inserted

[ALe]

there's the StrPtr function that can help you to determine if user pressed cancel. See below

Sub CheckIfCancelWasPressed()
Dim Response As String
Response = InputBox("Your string here:")
If StrPtr(Response) = 0 Then MsgBox "Cancel was pressed!"
End Sub

[johnske]

Sub test2()

Dim Cell As Range

Sheets("Sheet1").Activate
For Each Cell In Range("M5:O5")
If Cell = Empty Then
Cell = InputBox("Please enter the DATA missing from " & Cell.Address(0, 0))
If Cell = Empty Then Exit Sub
End If
Next
With Sheets("Sheet1")
.Range("M5", .Cells(.Rows.Count, "P").End(xlUp)).Copy Sheets("Sheet2").Range("C5")
End With
Sheets("Sheet2").Select
End Sub


and use the Cancel buttonWill do it :)

EDIT: Should you need to add other non-contiguous fields to be completed, just add them to the For_Each statement like in this example... For Each Cell In Range("A5, M5:O5, R6:R8, T7")

[ALe]

In the sub Test2 code stops also when you don't enter anything in the inputbox and then you press OK. That's why I suggested the StrPrt function. Code will be executed if you press OK but not if you press Cancel.

[mvidas]

From the land of "you could do it that way.. but it seems like more trouble than it's worth" comes the modeless userform method

Matt

[ALe]

Easy. Just two lines added.

Sub testNew()

Dim Cell As Range
Dim Response As String

Sheets("Sheet1").Activate
For Each Cell In Range("M5:O5")
If Cell = Empty Then
Response = InputBox("Please enter the DATA missing from " & Cell.Address(0, 0))
If StrPtr(Response) = 0 Then Exit Sub
If Cell = Empty Then testNew
End If
Next
With Sheets("Sheet1")
.Range("M5", .Cells(.Rows.Count, "P").End(xlUp)).Copy Sheets("Sheet2").Range("C5")
End With
Sheets("Sheet2").Select
End Sub

[vzachin]

hi ALe,

I get stuck in M5 no matter what I enter; it doesn't go to the next cell N5.


thanks
zach

[vzachin]

hi xld & Matt,
thanks for the coding. i couldn't use matt's because that would mean the users would have to know how to add the addin

zach

[Bob Phillips]

hi xld & Matt,
thanks for the coding. i couldn't use matt's because that would mean the users would have to know how to add the addin

zach

It was Johnske's, all I did was show you how to make that small change.

[ALe]

Sorry. I hadn't tested the code. This should work.

Sub testNew()

Dim Cell As Range
Dim Response As String

Sheets("Sheet1").Activate
For Each Cell In Range("M5:O5")
If Cell = Empty Then
Response = InputBox("Please enter the DATA missing from " & Cell.Address(0, 0))
If StrPtr(Response) = 0 Then Exit Sub
If Response = vbNullString Then testNew 'new line
Cell.Value = Response 'new line
End If
Next
With Sheets("Sheet1")
.Range("M5", .Cells(.Rows.Count, "P").End(xlUp)).Copy Sheets("Sheet2").Range("C5")
End With
Sheets("Sheet2").Select
End Sub

[mvidas]

zach,

I just put it in add-in form due to the mood I was in yesterday :) It doesn't have to be in an add-in by any means, its just a modeless userform. As I said it was an entry from the "why would you do it this way" category.

Matt

[vzachin]

cool Ale

thankx
zach

[ALe]

:thumb nice thread!

[mdmackillop]

The range in the examples is vey small, so looping is not a problem. For larger ranges you may wish to check if there are any blank cells first, and if so, loop through these cells only.

Option Explicit
Sub testNew()
Dim Cell As Range, Source As Range
Dim Response As String
Set Source = Sheets("Sheet1").Range("M5:O5")
'Test for any blank cells
If Application.WorksheetFunction.CountA(Source) < Source.Cells.Count Then
'Only loop through blank cells
For Each Cell In Source.SpecialCells(xlCellTypeBlanks)
Response = InputBox("Please enter the DATA missing from " & Cell.Address(0, 0))
If StrPtr(Response) = 0 Then Exit Sub
If Response = vbNullString Then testNew 'new line
Cell.Value = Response 'new line
Next
End If
With Sheets("Sheet1")
.Range("M5", .Cells(.Rows.Count, "P").End(xlUp)).Copy Sheets("Sheet2").Range("C5")
End With
Sheets("Sheet2").Select
End Sub