Return the result of a formula after finding word in a string

[andymalan]

Hello good people of Mr Excel. I need to find a specific word in a string, when found, copy the RESULT of a formula (in a different cell) and paste it to a cell in the same row as where the word was found.
The code I have managed to put together so far, finds the word “substituted” and inserts the values I want, but I need it to return the result of a formula. E.g. Max(“sheet1!D2:D99”)

code<>
Sub CheckIfRangeOfCellsContainsSpecificText_vba()

Sheets("Cabinets").Select
'excel, if range of cells contains specific text vba
Set Rng = Range("I2:I1500") ' User can edit this
specificText = "substituted" ' User can edit this


For Each cell In Rng.Cells

If UCase(cell.Value) Like "*" & UCase(specificText) & "*" Then

cell.Offset(0, -5) = "600"
cell.Offset(0, -4) = "16"
' Else
' cell.Offset(0, 2) = " "
End If
Next
Calculate

I will be ever so grateful for your help.
kind regards
Andy

 

[andymalan]

Hello good people of Mr Excel. I need to find a specific word in a string, when found, copy the RESULT of a formula (in a different cell) and paste it to a cell in the same row as where the word was found.
The code I have managed to put together so far, finds the word “substituted” and inserts the values I want, but I need it to return the result of a formula. E.g. Max(“sheet1!D2:D99”)
View attachment 70553

code<>
Sub CheckIfRangeOfCellsContainsSpecificText_vba()

Sheets("Cabinets").Select
'excel, if range of cells contains specific text vba
Set Rng = Range("I2:I1500") ' User can edit this
specificText = "substituted" ' User can edit this


For Each cell In Rng.Cells

If UCase(cell.Value) Like "*" & UCase(specificText) & "*" Then

cell.Offset(0, -5) = "600"
cell.Offset(0, -4) = "16"
' Else
' cell.Offset(0, 2) = " "
End If
Next
Calculate

I will be ever so grateful for your help.
kind regards
Andy

I am so hoping that someone can help with this problem I originally posted 4 days ago )

 

[Alex Blakenburg]

You will get a better response if you provide an XL2BB of you data. It often takes longer to set up some test data than it takes to address the issue.
I am not sure of what you are trying to achieve so lets start with the below and see where that takes us.

Sub CheckIfRangeOfCellsContainsSpecificText_vba_mod()

    Dim wsMain As Worksheet, wsGetData As Worksheet
    Dim rngDesc As Range, rCell As Range
    Dim specificText As String
    Dim lrGetData As Long

    Set wsMain = Worksheets("Cabinets")
    Set wsGetData = Worksheets("Sheet1")    ' <--- Put in correct sheet name
    lrGetData = wsGetData.Range("D" & Rows.Count).End(xlUp).Row
    
    'excel, if range of cells contains specific text vba
    Set rngDesc = wsMain.Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row) ' User can edit this
    specificText = "substituted" ' User can edit this
    
    For Each rCell In rngDesc.Cells
        If UCase(rCell.Value) Like "*" & UCase(specificText) & "*" Then
        
            'cell.Offset(0, -5) = "600"
            rCell.Offset(0, -5).Value = WorksheetFunction.Max(wsGetData.Range("D2:D" & lrGetData))
            rCell.Offset(0, -4) = "16"
            ' Else
            ' cell.Offset(0, 2) = " "
        End If
    Next
    Calculate           ' shouldn't be required
End Sub

My sheet: Cabinets

20220806 VBA Substitute and Formula andymalan.xlsm
	A	B	C	D	E	F	G	H	I
1	Code	Hinge	Quantity	Col4	Col5	Col6	Col7	Col8	Description
2	F900		1	750	900	560	F	900	Floor unit w/2 doors, 900mm
3	F850		1	750	850	560	F	850	Height=900, Rebuilt front Floo unit
4	F750		1	750	750	560	F	750	Height=825, Rebuilt front Floo unit
5	FSS		1	300	16	560	FSS	0	Floor substituted side
6	F950		1	750	950	560	F	950	Floor unit w/2 doors, 950mm
7	WT750		1	750	750	300	WT	750	Depth=635 Wall transition unit w/2 doors
8	8148		1	750	8148	0	0	8148	Direction=Left strip handle bsn 256
Cabinets

My Sheet1

20220806 VBA Substitute and Formula andymalan.xlsm
	A	B	C	D	E
1				Max of this
2				100
3				200
4				300
5				50
6				150
7				250
sheet1