runtime error 1004 vb

Hi

Can anyone help me resolve an issue with the code below. I am getting a runtime error 1004, i highlighted the problem in the code. i am running excel 2007
i appreciate any help

Sub setNames(theTopLeft As Range)
Dim theName As Name
Dim nameStr As String
Dim theRng As Range
Dim i As Long
    Application.DisplayAlerts = False
    theTopLeft.CurrentRegion.CreateNames Top:=True, Left:=False, _
                    Bottom:=False, Right:=False
    Application.DisplayAlerts = True
    For Each theName In ThisWorkbook.Names
        With theName.RefersToRange
            For i = .Cells.Count To 1 Step -1
                If .Cells(i) <> "" Then Exit For
            Next
        End With
        If i <> 0 Then theName.RefersTo = theName.RefersToRange.Resize(i, 1)
    Next
End Sub

Andy,

Thank you for replying, i tired to point it to the sheet, folder and range name, but it did not like RefersToRange and the .cells(i)..
I am using this code in the module, it is used with a main() to populate a combobox with one of 3 named ranges depending on a cell value. The main() an setNmaes are on the module, and the combobox and the named ranges are in sheet1.
Can you kindly help?

Originally Posted by Andy Pope

None of that makes sense, to me, in regards to the questions I asked.

post example file

I have attached an example, thank you for your time much appreciated

Thanks Andy, i agree i missed that.
I tried your code, but i am still getting a runtime error 1004
this selection is not valid
theTopLeft.CurrentRegion.CreateNames Top:=True, Left:=False, _
Bottom:=False, Right:=False
i suspect it is the refertorange not working, maybe i need an addin?
I am a novice, so i don't know what i am doing yet
Please help

Sorry, i misunderstood. (i read the comment, i just didn't understand it)
setNames is not defined in the Main()?

Please excuse my ignorance, but i am trying

Thank you Andy,
I am getting Error 1004 application-define or object define error from this: With theName.RefersToRange
this is what i have on the module after the changes you recommended
I think i am getting close, thanks to you. I hope you can help me figure it out

Sub MAIN()
Dim PT As Range
Dim i As Long
    With Sheet2  ' Unique SPP
        setNames .Range("a6")
        Set PT = .Range("b1")
End With
End Sub
Sub setNames(theTopLeft As Range)
Dim theName As Name
Dim nameStr As String
Dim theRng As Range
Dim i As Long
    Application.DisplayAlerts = False
    theTopLeft.CurrentRegion.CreateNames Top:=True, Left:=False, _
                    Bottom:=False, Right:=False
    Application.DisplayAlerts = True
    For Each theName In ThisWorkbook.Names
        With theName.RefersToRange
            For i = .Cells.Count To 1 Step -1
               
        If .Cells(i) <> "" Then Exit For
            Next
        End With
        If i <> 0 Then theName.RefersTo = theName.RefersToRange.Resize(i, 1)
    
    Next
    
    
End Sub