Edit new code to allow update of posiitional references to be edited by user.

[heroofgoodwi]

Hey guys,

So I am a little bit stuck, I currently have a piece of code which I recently wrote which allows the user to pull data from a closed workbook and import it into the one they currently have open.

While I am very happy with how this works at the moment the end goal needs to be to have some kind of user input to allow the user to select a cell range to pull and the cell range which determines the final location for the data.

Currently these are set to $A$1:$Z$100 for both but I would like to be able to have the user select these ranges without having to go into vba and actually edit the code itself.

Does anyone have any suggestions about how to achieve this. Code displayed below.



Sub PulldatawithsafetyQuestion()
'Safety question to check if used has saved a back up
'This will exit the sub if the user selects NO
Q1 = MsgBox("Have you saved a back up copy of this worksheet?", vbQuestion + vbYesNo)
If Q1 = vbNo Then Exit Sub

Dim mydata As String
'data location & range to copy
mydata = "='C:\[FilePathto\:Cdrive]Sheet1'!$A$1:$Z$100" '<< change as required
'(LOCATION TO PULL FROM)
'link to worksheet
With ThisWorkbook.Worksheets(1).Range("$A$1:$Z$100") '<< change as required (LOCATION TO MOVE DATA TO)
.Formula = mydata
'convert formula to text
.Value = .Value

MsgBox "Your data has now been copied across"
End With
End Sub

[Bob Phillips]

Sub PulldatawithsafetyQuestion()
Dim rng As Range
Dim Q1 As VbMsgBoxResult
Dim mydata As String

'Safety question to check if used has saved a back up
'This will exit the sub if the user selects NO
Q1 = MsgBox("Have you saved a back up copy of this worksheet?", vbQuestion + vbYesNo)
If Q1 = vbNo Then Exit Sub

'data location & range to copy
Set rng = GetRange("Use the mouse to select the range to copy from")
If Not rng Is Nothing Then

mydata = "='C:\[FilePathto\:Cdrive]Sheet1'!" & rng.Address

Set rng = Nothing

'(LOCATION TO PULL FROM)
'link to worksheet
ThisWorkbook.Worksheets(1).Activate

Set rng = GetRange("Use the mouse to select the range to copy to")
If Not rng Is Nothing Then

With rng

.Formula = mydata
'convert formula to text
.Value = .Value

MsgBox "Your data has now been copied across"
End With
End If
End If
End Sub

Private Function GetRange(ByVal msg As String) As Range
On Error Resume Next
Set GetRange = Application.InputBox("Use the mouse to select the range to copy to", Type:=8)
End Function

[heroofgoodwi]

Wow thank you so much that is absolutely amazing. It works perfectly!