InputBox Method not returning ranges (Type =8)

[G12]

Hello.

I am trying to modify the unique and sort code below (as provided by someone on the forum) to allow it to stand alone ie. not have to go into the editor to change the ranges.

To this end I was hoping to use the inbox method to return the ranges. Everything I have read tells me to define the inputbox as type 8. Which is what I thought I had done.

However. It still returns the cell value rather than the range.

What am I doing wrong?

Thanks

G12


Sub UniqueSort3()
Dim a, e As Variant
Dim Rng1 As Range
Dim Rng2 As Range

Set Rng1 = Application.InputBox( _
prompt:="Specify a Cell to Start From:", _
Title:="Input Cell Reference", Type:=8)
If Rng1 Is Nothing Then Exit Sub

Set Rng2 = Application.InputBox( _
prompt:="Specify a Destination Cell:", _
Type:=8)
If Rng2 Is Nothing Then Exit Sub

'' Rspn = InputBox("Please Insert Sorting Start Point Cell", "Input Cell Reference", "For Example C3")
''
'' If Rspn = "" Then GoTo SRTCNL
''
''' Range("E2:K2").Value = Rspn

a = Range(Rng1, Range(Rng1(remember to adjust range for column value only) & Rows.Count).End(xlUp)).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each e In a
.Item(e) = .Item(e) + 1
Next
Range(Rng2).Resize(.Count, 2).Value = Application.Transpose(Array(.keys, .items))
End With
Range(Rng2).CurrentRegion.Sort Range(Rng2), 1

SRTCNL:
MsgBox "The Unique and Sort Has Been Cancelled", vbOKOnly
End Sub

 

[Richard Schollar]

Try amending the mid block of code to:

a = Range(Rng1, Cells(Rows.Count,Rng1.Column).End(xlUp)).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each e In a
.Item(e) = .Item(e) + 1
Next
Rng2.Resize(.Count, 2).Value = Application.Transpose(Array(.keys, .items))
End With
Rng2.CurrentRegion.Sort Rng2,1

 

[Jonmo1]

Try this

Sub UniqueSort3()
Dim a, e As Variant
Dim Rng1 As Range
Dim Rng2 As Range
Set Rng1 = Application.InputBox( _
prompt:="Specify a Cell to Start From:", _
Title:="Input Cell Reference", Type:=8)
If Rng1 Is Nothing Then Exit Sub
Set Rng2 = Application.InputBox( _
prompt:="Specify a Destination Cell:", _
Type:=8)
If Rng2 Is Nothing Then Exit Sub
'' Rspn = InputBox("Please Insert Sorting Start Point Cell", "Input Cell Reference", "For Example C3")
''
'' If Rspn = "" Then GoTo SRTCNL
''
''' Range("E2:K2").Value = Rspn
a = Range(Rng1.Address, Cells(Rows.Count, Rng1.Column).End(xlUp))
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each e In a
        .Item(e) = .Item(e) + 1
    Next
    Rng2.Resize(.Count, 2).Value = Application.Transpose(Array(.keys, .items))
End With
Rng2.CurrentRegion.Sort Rng2, 1
SRTCNL:
MsgBox "The Unique and Sort Has Been Cancelled", vbOKOnly
End Sub

 

[G12]

Thanks Guys.

Final code works great added an additional Exit Sub at bottom (which I had missed).

Unique and Sort Final Code

Sub UniqueSort()
Dim a, e As Variant
Dim Rng1 As Range
Dim Rng2 As Range

On Error Resume Next

Set Rng1 = Application.InputBox( _
prompt:="Specify a Cell to Start From:", _
Title:="Input Cell Reference", Type:=8)
If Rng1 Is Nothing Then GoTo SRTCNL

Set Rng2 = Application.InputBox( _
prompt:="Specify a Destination Cell:", _
Type:=8)
If Rng2 Is Nothing Then GoTo SRTCNL

a = Range(Rng1.Address, Cells(Rows.Count, Rng1.Column).End(xlUp))
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each e In a
.Item(e) = .Item(e) + 1
Next
Rng2.Resize(.Count, 2).Value = Application.Transpose(Array(.keys, .items))
End With
Rng2.CurrentRegion.Sort Rng2, 1

Exit Sub

SRTCNL:
MsgBox "The Unique and Sort Has Been Cancelled", vbOKOnly
End Sub