SeanBaird
SeanBaird

Reputation: 59

Extracting Text from a cell

I have a search function which works perfectly for searching for Exact Numerical values, However I need to adapt it so it searches for text within a cell and only extracts that text. For example it searches column 7. In column 7 there may be a cell containing the words Interface - HPT, SAS, LPT Ideally I would like to search for the word Interface - HPT then extract Only this text from the cell. I also need the search function to be able to do this for multiple different values. So for example run a search for Interface - HPT Interface - SAS and Interface LPT separate from each other. Is this Possible ?

Here is the code I have at the moment:

Sub InterfaceMacro()

Dim Headers() As String: Headers = _
    Split("Target FMECA,Part I.D,Line I.D,Part No.,Part Name,Failure Mode,Assumed System Effect,Assumed Engine Effect", ",")

    Worksheets.Add().Name = "Interface"
    Dim wsInt As Worksheet: Set wsInt = Sheets("Interface")
    wsInt.Move after:=Worksheets(Worksheets.Count)
    wsInt.Cells.Clear

    Application.ScreenUpdating = False

    With wsFHA
        For i = 0 To UBound(Headers)
            .Cells(2, i + 2) = Headers(i)
            .Columns(i + 2).EntireColumn.AutoFit
        Next i
        .Cells(1, 2) = "Interface TABLE"
        .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).MergeCells = True
        .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).HorizontalAlignment = xlCenter
        .Range(.Cells(1, 2), .Cells(2, UBound(Headers) + 2)).Font.Bold = True
    End With

    Dim SourceCell As Range, FirstAdr As String
    Dim RowCounter As Long: RowCounter = 3

    Dim SearchTarget() As String
    SearchTarget = Split("9.1,18.0", ",")

    For i = 0 To UBound(SearchTarget)
        If Worksheets.Count > 1 Then
            For j = 1 To Worksheets.Count - 1
            With Sheets(j)
                Set SourceCell = .Columns(7).Find(SearchTarget(i), LookAt:=xlWhole)
                If Not SourceCell Is Nothing Then
                    FirstAdr = SourceCell.Address
                    Do
                        wsInt.Cells(RowCounter, 2).Value = SearchTarget(i)
                        wsInt.Cells(RowCounter, 3).Value = .Cells(SourceCell.Row, 6).Value
                        wsInt.Cells(RowCounter, 4).Value = .Cells(3, 10).Value
                        wsInt.Cells(RowCounter, 5).Value = .Cells(2, 10).Value
                        wsInt.Cells(RowCounter, 6).Value = .Cells(SourceCell.Row, 2).Value
                        For k = 0 To SourceCell.Row - 1
                            If .Cells(SourceCell.Row - k, 3).Value <> "continued." Then
                                wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row - k, 3).Value
                                Exit For
                            End If
                        Next k
                        wsInt.Cells(RowCounter, 8).Value = .Cells(SourceCell.Row, 14).Value
                        Set SourceCell = .Columns(7).FindNext(SourceCell)
                        RowCounter = RowCounter + 1
                    Loop While Not SourceCell Is Nothing And SourceCell.Address <> FirstAdr
                End If
            End With
            Next j
        End If
    Next i


    End Sub

The part I believe needs editing is this section

Dim SourceCell As Range, FirstAdr As String
        Dim RowCounter As Long: RowCounter = 3

        Dim SearchTarget() As String
        SearchTarget = Split("9.1,18.0", ",")

        For i = 0 To UBound(SearchTarget)
            If Worksheets.Count > 1 Then
                For j = 1 To Worksheets.Count - 1
                With Sheets(j)
                    Set SourceCell = .Columns(7).Find(SearchTarget(i), LookAt:=xlWhole)
                    If Not SourceCell Is Nothing Then
                        FirstAdr = SourceCell.Address

Upvotes: 0

Views: 198

Answers (1)

You can define the array to search the same way as you define it for numbers.

To search also part of the cell content you need to change .Find(SearchTarget(i), LookAt:=xlWhole) to .Find(SearchTarget(i), LookAt:=xlPart).

VBA looks in formulas / results the same way as it works in Find / Replace dialog. (set .LookIn to either xlValues or xlFormulas)

Upvotes: 1

Related Questions