INPUT BOX
 

I use the following code that I found online and modified, to update
data in my various worksheets. I was wondering if anyone knows how to
make it so that when I insert a date into the different columns I can
use an input box instead of always going to the code module.

For example below 13 June 07 will go into the MSA column but not in
ARS. An input box for each is what I am trying to attain without going
into the code module.

example
----------------------------------------------------------------------
'MSA Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = ""
Next y
Next x
'ARS Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 3) = "13 JUNE 07"
Next y
Next x
----------------------------------------------------------------------

Sub Find_Matches()

Dim CompareRange As Variant, x As Variant, y As Variant
' Set CompareRange equal to the range to which you will
' compare the selection.
Set CompareRange = Workbooks("LookUP1"). _
Worksheets("Sheet1").Range("A3:A41")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.
Application.ScreenUpdating = False
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each x In Selection
For Each y In CompareRange
If x = y Then y.Offset(0, 1) = "Matched"
Next y
Next x
'MSA Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = ""
Next y
Next x
'ARS Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 3) = "13 JUNE 07"
Next y
Next x
'MSA 3 Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 4) = ""
Next y
Next x
'Shelf Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 5) = ""
Next y
Next x
'Shop Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 6) = ""
Next y
Next x
Application.ScreenUpdating = True
End Sub

INPUT BOX
 

Is this what you mean?

'MSA Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = InputBox("Enter Date", "DATE")
Next y
Next x
'ARS Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 3) = InputBox("Enter Date", "DATE")
Next y
Next x

You might have to format the results of the input box, depending on how you
have the receiving range formatted. If you get a type mismatch error, you
will know.


"QTGlennM" wrote:

I use the following code that I found online and modified, to update
data in my various worksheets. I was wondering if anyone knows how to
make it so that when I insert a date into the different columns I can
use an input box instead of always going to the code module.

For example below 13 June 07 will go into the MSA column but not in
ARS. An input box for each is what I am trying to attain without going
into the code module.

example
----------------------------------------------------------------------
'MSA Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = ""
Next y
Next x
'ARS Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 3) = "13 JUNE 07"
Next y
Next x
----------------------------------------------------------------------

Sub Find_Matches()

Dim CompareRange As Variant, x As Variant, y As Variant
' Set CompareRange equal to the range to which you will
' compare the selection.
Set CompareRange = Workbooks("LookUP1"). _
Worksheets("Sheet1").Range("A3:A41")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.
Application.ScreenUpdating = False
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each x In Selection
For Each y In CompareRange
If x = y Then y.Offset(0, 1) = "Matched"
Next y
Next x
'MSA Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = ""
Next y
Next x
'ARS Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 3) = "13 JUNE 07"
Next y
Next x
'MSA 3 Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 4) = ""
Next y
Next x
'Shelf Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 5) = ""
Next y
Next x
'Shop Column
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 6) = ""
Next y
Next x
Application.ScreenUpdating = True
End Sub