Question : Find a Text in a cell and copy it to another cell.

Hi experts

I am interest in knowing how to get a specific word/number from a cell and copy it into a place holder within a cell.

For instance .....
Cell A1 will have the following data within.
Output Current = [2.000]
Signal Frequency = [140]

In cell A1, the number within the backets "i.e [2.000 ]" will get copy in B2.
For instance, The enclosed number will appear in cell A2 as followed.
Verified Output Current is [2.00]
Verified Signal Frequency is [140]

Please use the attached excel copy to show example.
The blue txt is the data entered and the red are the copied text.

Answer : Find a Text in a cell and copy it to another cell.

OK this is what I have. No limits on the
The usage rules are as follows:
The fill in data has to have a numer in it that is to be replaced.
The LookFor Data must be the same. ex On-Time must be in the fill data not On Time. (second one has no dash)
There is no need for extra room for the more entry fields, just in column A you just add them in this format "lookfor = value"
in the cells with the descriptions make sure that the lookfor is in the cell with a number you want to replace.

I didn't comment the code but I can if needed.

dragontooth

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:

           
           
             Sub TryIt()
    Dim LkFor() As String, Info() As String
    LookForEqual LkFor, Info
    For mI = LBound(LkFor, 1) To UBound(LkFor, 1)
        If LkFor(mI) <> "" Then
            FindItReplaceIt LkFor(mI), Info(mI)
        End If
    Next
End Sub

Sub FindItReplaceIt(LookFor As String, ReplaceWith As String)
    Dim NewCell As Range, mData As String, firstAddress As String
    Dim NumSt As Long, NumEn As Long
    Set NewCell = Cells.Find(What:=LookFor, After:=ActiveCell, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    While Not NewCell Is Nothing
        mData = NewCell.Text
        NumSt = InStr(1, mData, LookFor, vbTextCompare)
        While Not IsNumeric(Mid(mData, NumSt, 1))
            NumSt = NumSt + 1
        Wend
        NumEn = NumSt
        While IsNumeric(Mid(mData, NumEn, 1)) Or Mid(mData, NumEn, 1) = "."
            NumEn = NumEn + 1
        Wend
        mData = Left(mData, NumSt - 1) & ReplaceWith & Mid(mData, NumEn)
        Cells(NewCell.Row, NewCell.Column) = mData
        Set NewCell = Cells.FindNext(NewCell)
        'if I have come back to column 1 I am at the start
        If NewCell.Column = 1 Then Exit Sub
    Wend
End Sub
Sub LookForEqual(iData() As String, Info() As String)
    Dim mCellStr As String, mI As Long, AllD() As String, cnt As Long, mN As Long
    ReDim iData(0)
    ReDim Info(0)
    mN = 0
    mCellStr = ActiveCell
    AllD = Split(mCellStr, vbLf)
    For mI = LBound(AllD, 1) To UBound(AllD, 1)
        If InStr(1, AllD(mI), "=") Then
            cnt = UBound(iData, 1)
            iData(mN) = BreakB4Eq(AllD(mI))
            Info(mN) = BreakEq(AllD(mI))
            ReDim Preserve iData(cnt + 1)
            ReDim Preserve Info(cnt + 1)
            mN = mN + 1
        End If
    Next
End Sub
Function BreakEq(iInfo As String) As String
    Dim hldStr As String
    hldStr = Mid$(iInfo, InStr(1, iInfo, "=") + 1)
    BreakEq = Trim(Replace(Replace(hldStr, "[", ""), "]", ""))
End Function
Function BreakB4Eq(iInfo As String) As String
    Dim hldStr As String
    hldStr = Trim(Left$(iInfo, InStr(1, iInfo, "=") - 1))
    BreakB4Eq = hldStr
End Function

           
         

Open in New Window

Select All

Testa.xls (21 KB) (File Type Details)

updated test file