Auto Range? VBA

[hollytrab]

Is there a way for excel to create a range simply because a specific column contains certain text?

I have a spreadsheet sheet 1 A:R. If Column C contains "Basic Life Insurance", I want a range created of all rows that contain "Basic Life Insurance" in column C and name the range BasicLife.

 

[Artik]

Specify the estimated maximum number of occurrences of the phrase in column C.

Artik

 

[Artik]

Try it:

Sub AAA()
    Dim rngSource As Range
    Dim Address1 As String
    Dim rngFound As Range
    Dim rng As Range

    Set rngSource = Intersect(ActiveSheet.UsedRange, Columns("C"))

    With rngSource
        Set rng = .Find("Basic Life Insurance", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

        If Not rng Is Nothing Then
            Address1 = rng.Address
            Set rngFound = rng

            Do
                Set rngFound = Union(rngFound, rng)
                Set rng = .FindNext(After:=rng)
            Loop While rng.Address <> Address1

            ThisWorkbook.Names.Add Name:="BasicLife", RefersTo:=rngFound
        End If

    End With
   
End Sub

Artik

 

[hollytrab]

Try it:

Sub AAA()
    Dim rngSource As Range
    Dim Address1 As String
    Dim rngFound As Range
    Dim rng As Range

    Set rngSource = Intersect(ActiveSheet.UsedRange, Columns("C"))

    With rngSource
        Set rng = .Find("Basic Life Insurance", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

        If Not rng Is Nothing Then
            Address1 = rng.Address
            Set rngFound = rng

            Do
                Set rngFound = Union(rngFound, rng)
                Set rng = .FindNext(After:=rng)
            Loop While rng.Address <> Address1

            ThisWorkbook.Names.Add Name:="BasicLife", RefersTo:=rngFound
        End If

    End With
  
End Sub

Artik

Hello, this works however, I need it to grab the whole row, not just the cell in column C. Row range A:Y. Can you help me tweak your original post?

 

[Artik]

Sub BBB()
    Dim rngSource As Range
    Dim Address1 As String
    Dim rngFound As Range
    Dim rng As Range

    Set rngSource = Intersect(ActiveSheet.UsedRange, Columns("C"))

    With rngSource
        Set rng = .Find("Basic Life Insurance", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

        If Not rng Is Nothing Then
            Address1 = rng.Address
            Set rngFound = Range(Cells(rng.Row, "A"), Cells(rng.Row, "Y"))

            Do
                Set rngFound = Union(rngFound, Range(Cells(rng.Row, "A"), Cells(rng.Row, "Y")))
                Set rng = .FindNext(After:=rng)
            Loop While rng.Address <> Address1

            ThisWorkbook.Names.Add Name:="BasicLife", RefersTo:=rngFound
        End If

    End With
  
End Sub

Artik

 

[hollytrab]

Sub BBB()
    Dim rngSource As Range
    Dim Address1 As String
    Dim rngFound As Range
    Dim rng As Range

    Set rngSource = Intersect(ActiveSheet.UsedRange, Columns("C"))

    With rngSource
        Set rng = .Find("Basic Life Insurance", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

        If Not rng Is Nothing Then
            Address1 = rng.Address
            Set rngFound = Range(Cells(rng.Row, "A"), Cells(rng.Row, "Y"))

            Do
                Set rngFound = Union(rngFound, Range(Cells(rng.Row, "A"), Cells(rng.Row, "Y")))
                Set rng = .FindNext(After:=rng)
            Loop While rng.Address <> Address1

            ThisWorkbook.Names.Add Name:="BasicLife", RefersTo:=rngFound
        End If

    End With
 
End Sub

Artik

Amazing!!! Exactly what I needed. Thank you!!!!