VBA macro

I've been working away at this for some time now and I have gotten closer and I think I have found a workaround for handling separate cell combination. But I am having issues making the second half, the Dup Destroyer, selecting the range I need it to. The original Macro I copied was designed for a Selection. I am needing it to be locked to a rank J1:K121. and there is nothing else it needs to be used for. The other part I haven't been able to figure out is having it delete lines with no data in them. It could test K2:K121 for cells with no data and then remove the corresponding Row. Here is the Macro I have as of current. Any help is greatly appreciated! Thank you for your time!

Sub MoveAndRemove()

Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select

Range("H1:H121").Select
Selection.Copy
Range("J1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H121").Select

Range("H1:H121").Select
Range("H121").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("J1").Select

Dim R As Range
Dim Dic As Variant
Dim arr As Variant
On Error Resume Next
xTitleId = "Dup Destroyer"
Set R = Range("J2:K121").Select
Set R = Application.InputBox("Range", xTitleId, R.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")
arr = R.Value
For i = 1 To UBound(arr, 1)
Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
Next
Application.ScreenUpdating = False
R.ClearContents
R.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
R.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
Application.ScreenUpdating = True

Range("J1:J121").Select
Selection.Copy
Range("H1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J121").Select

Range("J1:J121").Select
Range("J121").Activate
Application.CutCopyMode = False
Selection.ClearContents
Selection.EntireColumn.Delete

End Sub