Adding to code to prompt user...

bsnapool

Active Member
Joined
Jul 10, 2006
Messages
452
Hi All

I was wondering if somebody could be kind enough to help me with a problem I have?

The problem...


I have the below code:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet
If Target.Address(0, 0) = "Q7" Then
On Error Resume Next
Set Sh = Worksheets(Target.Value)
On Error GoTo 0
If Not Sh Is Nothing Then
With Sh
.Unprotect "liverpool"
Cells.Copy .Cells
.Tab.ColorIndex = 3
.Protect "liverpool"
End With
Else
MsgBox Target.Value & " does not exist"
End If
End If
End Sub

How the code works is when a number is entered into Q7 and enter is press the the data is copied to the the relevant tab.

Is there a way Iwhen enter is pressed, a prompt could appear to say this will now be copied to tab number what was entered into Q7 do you wish to copy or cancel???

Your help would really be appreciated..

Many thanks

Andrew
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Hi Andrew,

First things first, congrats on your 100th post! :-D

Now, down to business. ;-)

How about something like this ...

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet, Msg As VbMsgBoxResult
    If Target.Address(0, 0) = "Q7" Then
        Msg = MsgBox("Do you wish to copy the cells to sheet " & Target.Value & "?", vbYesNo)
        If Msg = vbNo Then Exit Sub
        On Error Resume Next
        Set Sh = Worksheets(Target.Value)
        On Error GoTo 0
        If Not Sh Is Nothing And Sh.Name <> Me.Name Then
            With Sh
                .Unprotect "liverpool"
                Me.Cells.Copy .Cells
                .Tab.ColorIndex = 3
                .Protect "liverpool"
            End With
        Else
            MsgBox "Sheet " & Target.Value & " does not exist"
        End If
    End If
End Sub

HTH
 
Upvote 0
Code:
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim response
response = msgbox("Would you like to paste this into ....",vbYesNo)
If response = vbYes Then
Dim Sh As Worksheet 
If Target.Address(0, 0) = "Q7" Then 
On Error Resume Next 
Set Sh = Worksheets(Target.Value) 
On Error GoTo 0 
If Not Sh Is Nothing Then 
With Sh 
.Unprotect "liverpool" 
Cells.Copy .Cells 
.Tab.ColorIndex = 3 
.Protect "liverpool" 
End With 
Else 
MsgBox Target.Value & " does not exist" 
End If 
End If 
End If
End Sub
 
Upvote 0
Wow, I didnt even realise, I had made 100 posts... Time flys when your having fun.. ha ha

Thanks for both your quick responses... But firefytr your code was spot...

Thanks for all your help.

All the best

Andrew
 
Upvote 0

Forum statistics

Threads
1,223,167
Messages
6,170,469
Members
452,330
Latest member
AFK_Matrix

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top