Create a range from another range

[zubair57]

Hi,

I am a beginner with VBA.
I want to write a code that can extract particluar cells from a named range.
For example I want to extract all the cells in column 1 say "Myrange" which contain Apples as a separate range i.e. desiredrange

MYRANGE DESIREDRANGE
1 7 Apples
2 11 Apples
3 15 Apples
4
5
6
7 Apples
8
9
10
11 Apples
12
13
14
15 Apples

I tried to writing this code but doesn't work. Please help me out. Thanks

Function extractarray(X As Range, Y As String) As Range
Dim Templist()
Dim I As Integer, J As Integer
J = 0
For I = 1 To X.Rows.Count
If Not InStr(X.Cells(I, 1), Y) = 0 Then
J = J + 1
End If
Next I
Numcount = J
K = 0
ReDim Templist(1 To Numcount)
For I = 1 To X.Rows.Count
If Not InStr(X.Cells(I, 1), Y) = 0 Then
K = 0 + K
Templist(K) = X.Value
End If
Next I
extractarray = Templist
End Function

[TMS]

Maybe something like this:

Option Explicit

Function fSubRange(rng As Range, sSubRng As String) As String

' worksheet call: =fSubRange(MyRange,"Apples")
' worksheet call: =fSubRange($A$2:$A$16,"Apples")

Dim rSubRng As Range, cell As Range

For Each cell In rng
    If cell.Offset(, 1).Value = sSubRng Then
        If rSubRng Is Nothing Then
            Set rSubRng = cell
        Else
            Set rSubRng = Union(rSubRng, cell)
        End If
    End If
Next 'cell

fSubRange = rSubRng.Address

End Function

Regards, TMS

[zubair57]

Hi TMS,

When I use this function as an array formula, it doesn't work.

Actually the function I need is a replacement of excel's data filter function.
If I use the excel data filter function it will filter all the cells that do not contain text "Apples".
But I need a formula to do this for me. The cells which I want to be displayed contain other text besides "apples".

I will reexplain what I need
My datarange is below

13
123
231
213
123
45
7 Apples
321
213
10
11 Apples
23
132
213
15 Apples
2131
123
213

And I need function/ formula to return the range below

7 Apples
11 Apples
15 Apples

[xlbiznes]

Hi,

this might help.

Sub String_Search()
'code by xlbiznes
Dim rng As Range
Dim cl As Range
Dim ctr As Integer ' to hold the instances of our search
ctr = 1
Set rng = Range("myrange")
For Each cl In rng ' loop through the range
    
    If InStr(1, cl.Text, "Apples", vbTextCompare) > 1 Then ' search within the string for the word Apples.
    Range("e" & ctr) = cl.Text 'if found start populating the column e with the instance and increment the ctr by 1
    ctr = ctr + 1
    End If
    
Next cl
MsgBox "Process Completed !" & ctr - 1 & " Instances Found", vbInformation, "Xlbiznes"
End Sub

[skywriter]

Maybe this.