Replace fixed location in MACRO with user selection

[CordingBags]

I obtained the following macro using "macro recorder", however I need to replace the fixed locations with user input, as indicated.


Sub Macro1()

Rows("20:20").Select - (replace with user input 1)
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("26:26").Select - (replace with user input 2)
Selection.Cut
Rows("20:20").Select - (replace with user input 1)
ActiveSheet.Paste
Rows("26:26").Select - (replace with user input 2)
Selection.Delete Shift:=xlUp
Range("F11").Select
End Sub

Any help appreciated
Thanks
Paul

 

[CephasOz]

Does this meet your need? (To copy this code, click the "Copy to clipboard" button to the right.)

Sub Macro1()
    Const cstrTitle As String = "Move Row"
    Dim strErrMsg As String
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lngRow1 As Long
    Dim lngRow2 As Long
    '
    On Error GoTo Err_Exit
    strErrMsg = vbNullString
    '
    On Error Resume Next
    Set rng1 = Application.InputBox("Select any cell in the DESTINATION ROW", cstrTitle, Selection.Address, Type:=8)
    On Error GoTo Err_Exit
    If (Not (rng1 Is Nothing)) Then
        Set rng1 = rng1.Areas(1).Rows(1)
        lngRow1 = rng1.Row
        rng1.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        On Error Resume Next
        Set rng2 = Application.InputBox("Select any cell in the row to be MOVED", cstrTitle, Selection.Address, Type:=8)
        On Error GoTo Err_Exit
        If (rng2 Is Nothing) Then
            rng1.Parent.Rows(lngRow1).EntireRow.Delete
        Else
            Set rng2 = rng2.Areas(1).Rows(1)
            lngRow2 = rng2.Row
            rng2.EntireRow.Cut Destination:=rng1.Parent.Rows(lngRow1)
            rng2.Parent.Rows(lngRow2).EntireRow.Delete
        End If
    End If
    '
Housekeeping:
    If (Len(strErrMsg) > 0) Then
        MsgBox strErrMsg, vbCritical + vbOKOnly, cstrTitle
    End If
    Exit Sub
Err_Exit:
    strErrMsg = Err.Number & ": " & Err.Description
    Err.Clear
    Resume Housekeeping
End Sub

 

[CordingBags]

Does this meet your need? (To copy this code, click the "Copy to clipboard" button to the right.)

Sub Macro1()
    Const cstrTitle As String = "Move Row"
    Dim strErrMsg As String
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lngRow1 As Long
    Dim lngRow2 As Long
    '
    On Error GoTo Err_Exit
    strErrMsg = vbNullString
    '
    On Error Resume Next
    Set rng1 = Application.InputBox("Select any cell in the DESTINATION ROW", cstrTitle, Selection.Address, Type:=8)
    On Error GoTo Err_Exit
    If (Not (rng1 Is Nothing)) Then
        Set rng1 = rng1.Areas(1).Rows(1)
        lngRow1 = rng1.Row
        rng1.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        On Error Resume Next
        Set rng2 = Application.InputBox("Select any cell in the row to be MOVED", cstrTitle, Selection.Address, Type:=8)
        On Error GoTo Err_Exit
        If (rng2 Is Nothing) Then
            rng1.Parent.Rows(lngRow1).EntireRow.Delete
        Else
            Set rng2 = rng2.Areas(1).Rows(1)
            lngRow2 = rng2.Row
            rng2.EntireRow.Cut Destination:=rng1.Parent.Rows(lngRow1)
            rng2.Parent.Rows(lngRow2).EntireRow.Delete
        End If
    End If
    '
Housekeeping:
    If (Len(strErrMsg) > 0) Then
        MsgBox strErrMsg, vbCritical + vbOKOnly, cstrTitle
    End If
    Exit Sub
Err_Exit:
    strErrMsg = Err.Number & ": " & Err.Description
    Err.Clear
    Resume Housekeeping
End Sub

Yes does just what I want.
Many Thanks

Paul

 

[CordingBags]

Yes does just what I want.
Many Thanks

Paul

PS Also this is the solution to my rather more verbose previous question Thanks