Could you look at the following code and tell me how I can select one cell, then it would find the range to copy to a new workbook? Thanks.
Sub InputBoxDemo()
Dim Message As String, Title As String, Default As String
Dim myRange As range, rngTotal As range, c As range
Const strFind As String = "Tot Samp - Mark"
'the text to find
Message = "Please select a starting range" ' Set prompt.
Title = "InputBox Demo" ' Set title.
Default = "User input here" ' Set default.
On Error Resume Next
Set myRange = Application.InputBox(Message, Title, Default, , , , ,8)
On Error GoTo 0
If myRange Is Nothing Then
MsgBox "You cancelled!"
Exit Sub
End If
With Worksheets("Mar03"
.range("A1:O105"
'amend range to suit
Set c = .Find(what:=strFind, after:=myRange, LookIn:=xlValues)
If Not c Is Nothing Then
'found it
Set rngTotal = .range(myRange, c.Offset(0, 2))
rngTotal.Select
End If
End With
End Sub
Sub InputBoxDemo()
Dim Message As String, Title As String, Default As String
Dim myRange As range, rngTotal As range, c As range
Const strFind As String = "Tot Samp - Mark"
'the text to find
Message = "Please select a starting range" ' Set prompt.
Title = "InputBox Demo" ' Set title.
Default = "User input here" ' Set default.
On Error Resume Next
Set myRange = Application.InputBox(Message, Title, Default, , , , ,8)
On Error GoTo 0
If myRange Is Nothing Then
MsgBox "You cancelled!"
Exit Sub
End If
With Worksheets("Mar03"


'amend range to suit
Set c = .Find(what:=strFind, after:=myRange, LookIn:=xlValues)
If Not c Is Nothing Then
'found it
Set rngTotal = .range(myRange, c.Offset(0, 2))
rngTotal.Select
End If
End With
End Sub