Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 And Target.Column = 4 Then
Sheets("JOB CHECK").Range("F1").Value = Target.Value
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
On Error GoTo M
If Not Intersect(Target, Range("D:D")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Sheets("JOB CHECK").Range("F1").Value = Target.Value
End If
Exit Sub
M:
MsgBox "You have no sheet named JOB CHECK "
End Sub
Thanks for the reply, I have a book with two sheets, sheet “A”and Sheet “B” I want to create a permanent list in sheet “A” A1,2,3,,4 and soon down to 100. Then when I click on any item in this list I want it to populatea list in sheet “B” A1,2,3,4 and so on down to 100 without any blank cells. I’m using the book to give to people when ordering a vehicle, sheet “A” will have all of the possible options to choose from and sheet “B” will have a list of what they have chosen. Hope this makes it clearer, cheers ChrisChris this does what you asked for in your first request. But does not copy to another sheet.
But then you seemed to say it would be even better if the script could do this:
So I'm not sure if you wanted both things or the second request and not the first request.
And also you said you wanted exactly the same.
So are you saying you have a sheet named "Job CHECK"
Sheets("JOB CHECK").Range("F1").Value = Target.Value
It may be clearer to say exactly what you want instead of saying do exactly as this but then do this and or this.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified 8/26/2018 11:44:35 PM EDT
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Cancel = True
Dim Lastrow As Long
Lastrow = Sheets("B").Cells(Rows.Count, "A").End(xlUp).Row + 1
Target.Copy Sheets("B").Cells(Lastrow, 1)
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified 8/28/2018 10:57:21 AM EDT
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Cancel = True
Dim Lastrow As Long
Lastrow = Sheets("List").Cells(Rows.Count, "A").End(xlUp).Row + 1
Target.Copy Sheets("List").Cells(Lastrow, 1)
End If
End Sub