VBA - Using Current Selection As Range Object

Question

I have this function below which does the following:

1. Takes two parameters (Header Name, Function Needed).
2. The Header Name parameter is used to find the heading and subsequently to identify the range of that column up until the last row.
3. The Function Needed parameter is used to switch in the select statement for any additional steps needed.
4. At the end of most of the statements, I do a Range.Select then I exit my function with a selected range.

Here is the code:

Function find_Header(header As String, fType As String)
    Dim aCell As Range, rng As Range
    Dim col As Long, lRow As Long
    Dim colName As String

    With ActiveSheet
        Set aCell = .Range("B2:J2").Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

        'If Found
        If Not aCell Is Nothing Then
            col = aCell.Column
            colName = Split(.Cells(, col).Address, "$")(1)

            lRow = Range(colName & .Rows.count).End(xlUp).Row + 1

            Set myCol = Range(colName & "2")

            Select Case fType
                Case "Copy"
                    'This is your range
                    Set rng = Range(myCol.Address & ":" & colName & lRow).Offset(1, 0)

                    rng.Select
            End Select

        'If not found
        Else
            MsgBox "Column Not Found"
        End If
    End With

End Function

As I am trying to clean up my code, I have come across a section where I have specifically hard coded ranges and I am trying to make use of my function instead, however, I am now at a point where I am unable to make use of this function correctly as I cannot "pass" the range back to the sub and I cannot seem to make the selection the range object needed for the sub.

Here is what is in the sub:

Sub Copy_Failed()
    Dim xRg As Range, xCell As Range
    Dim i As Long, J As Long, count As Long
    Dim fType As String, colName As String
    Dim y As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet

    myarray = Array("Defect", "System", "Script")
    myEnv = Array("SIT", "UAT")
    myDefects = Array("New", "Existing")

    i = Worksheets("Run Results").UsedRange.Rows.count
    J = Worksheets("Failed").UsedRange.Rows.count

    Set y = Workbooks("Template.xlsm")

    Set ws1 = y.Sheets("Failed")
    Set ws2 = y.Sheets("Run Results")

    count = 3

    If J = 1 Then

        If Application.WorksheetFunction.CountA(ws1.UsedRange) = 0 Then J = 0

    End If

    ws2.Activate

    fType = "Copy"
    colName = "Status"

    Call find_Header(colName, fType)
End Sub

Before I used the function, the code looked like this:

lngLastRow = Cells(Rows.count, "B").End(xlUp).Row

Set xRg = ws2.Range("E3:E" & lngLastRow & i)

Now these 2 lines are performed in the function, so I don't need it in the sub. I have tried the following:

Set rngMyRange = Selection

Set rngMyRange = ActiveSheet.Range(Selection.Address)

Set xRg = ws2.Range(rngMyRange  & i)

But I get the error:

Type mismatch

So I am thinking this:

1. Select the range in the function then use it in the sub - but how?
2. Figure out how to pass the actual range object from my function to the sub

Although the second option would require some extra changes in my code, I would think this is the better option to go with.

Answer 1

Ok, so here is an illustration just so you can see what I mean. If you put "one" somewhere in B2:J2 it will select the range. I am only using Select here so that you can see the range it identifies. (Disclaimer: I don't fully understand what you are doing, and not sure you need all this code to achieve what you want.)

The Function now returns a range variable, and is assigned to r. Run the procedure x.

Sub x()

Dim r As Range

Set r = Range("a1", find_Header("one", "Copy"))
r.Select

End Sub

---

Function find_Header(header As String, fType As String) As Range

Dim aCell As Range, rng As Range
Dim col As Long, lRow As Long
Dim colName As String

With ActiveSheet
    Set aCell = .Range("B2:J2").Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    'If Found
    If Not aCell Is Nothing Then
        col = aCell.Column
        colName = Split(.Cells(, col).Address, "$")(1)
        lRow = Range(colName & .Rows.Count).End(xlUp).Row + 1
        Set myCol = Range(colName & "2")
        Select Case fType
            Case "Copy"
                'This is your range
                Set find_Header = Range(myCol.Address & ":" & colName & lRow).Offset(1, 0)
            End Select
    'If not found
    Else
        Set find_Header = Nothing
    End If

End With

End Function