Macro to return value if cell contains certain text

D

dan4

New Member
Joined
Nov 23, 2010
Messages
38
Hello, I would like to write a macro to return values in adjacent cell if a cell contains certain text. For example, if D2 contains any of the following, write the corresponding value in E2; same for D3, D4, etc.:

If D2 contains "REG_EU", write Europe in E2 and/or
If D2 contains "CN", write China in E2 and/or
If D2 contains "US", write North America in E2 and/or
If D2 contains "REG_WORLD", write North America, Europe and China in E2.

I've included a sample for reference.

Any help would be appreciated. Thanks!

[TABLE="width: 788"]
<tbody>[TR]
[TD="width: 120, bgcolor: #BC4341"]SUBID
[/TD]
[TD="width: 120, bgcolor: #BC4341"]PFID
[/TD]
[TD="width: 200, bgcolor: #BC4341"]Short Description
[/TD]
[TD="width: 381, bgcolor: #BC4341"]Long Description
[/TD]
[TD="width: 231, bgcolor: #BC4341"]Impacted Region
[/TD]
[/TR]
[TR]
[TD="width: 120, bgcolor: transparent"]200000002401
[/TD]
[TD="width: 120, bgcolor: transparent"]00004346
[/TD]
[TD="width: 200, bgcolor: transparent"]Significant Change Specification: 200000002401 with PFID 00004346
[/TD]
[TD="width: 381, bgcolor: transparent"]Significant change: Complete GHS revisions for specification 200000002401. ||| Substance ID #: 200000002401 CN - Significant change due to HAZARDOUS INGREDIENTS ||| |||Note significant change reason. Run corresponding " RULES" to completion, create reports with languages from generation variants and extract GHS label data, when applicable,for products that require a GHS label.
[/TD]
[TD="width: 231, bgcolor: transparent"]China
[/TD]
[/TR]
[TR]
[TD="width: 120, bgcolor: transparent"]200000002402
[/TD]
[TD="width: 120, bgcolor: transparent"]00004397
[/TD]
[TD="width: 200, bgcolor: transparent"]Significant Change Specification: 200000002402 with PFID 00004397
[/TD]
[TD="width: 381, bgcolor: transparent"]Significant change: Complete GHS revisions for specification 200000002402. ||| Substance ID #: 200000002402 ||| US - Significant change due to HAZARDOUS INGREDIENTS ||| REG_EU - Significant change due to HAZARDOUS INGREDIENTS ||| CN - Significant change due to HAZARDOUS INGREDIENTS ||| |||Note significant change reason. Run corresponding " RULES" to completion, create reports with languages from generation variants and extract GHS label data, when applicable,for products that require a GHS label.
[/TD]
[TD="width: 231, bgcolor: transparent"]North America, Europe, China
[/TD]
[/TR]
[TR]
[TD="width: 120, bgcolor: transparent"]200000002411
[/TD]
[TD="width: 120, bgcolor: transparent"]00004850
[/TD]
[TD="width: 200, bgcolor: transparent"]Significant Change Specification: 200000002411 with PFID 00004850
[/TD]
[TD="width: 381, bgcolor: transparent"]Significant change: Complete GHS revisions for specification 200000002411. ||| Substance ID #: 200000002411 ||| REG_EU - Significant change due to HAZARDOUS INGREDIENTS ||| CN - Significant change due to HAZARDOUS INGREDIENTS ||| |||Note significant change reason. Run corresponding " RULES" to completion, create reports with languages from generation variants and extract GHS label data, when applicable,for products that require a GHS label.
[/TD]
[TD="width: 231, bgcolor: transparent"]Europe, China
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Try:
Code: 
Sub dan4()
    Application.ScreenUpdating = False
    Dim LastRow As Long, fnd As Range, region As Range, arr As Variant, i As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    arr = Array(" REG_EU ", " CN ", " US ", " REG_WORLD ")
    For Each region In Range("D2:D" & LastRow)
        For i = LBound(arr) To UBound(arr)
            If InStr(1, region, arr(i)) > 0 Then
                Select Case arr(i)
                    Case " REG_EU "
                        region.Offset(0, 1).Value = region.Offset(0, 1).Value & ", " & "Europe"
                    Case " CN "
                        region.Offset(0, 1).Value = region.Offset(0, 1).Value & ", " & "China"
                    Case " US "
                        region.Offset(0, 1).Value = region.Offset(0, 1).Value & ", " & "North America"
                    Case " REG_WORLD "
                        region.Offset(0, 1).Value = region.Offset(0, 1).Value & ", " & "North America, Europe,China"
                End Select
            End If
        Next i
        region.Offset(0, 1).Value = Mid(region.Offset(0, 1).Value, 3)
    Next region
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
dan4 said:
Hello, I would like to write a macro to return values in adjacent cell if a cell contains certain text. For example, if D2 contains any of the following, write the corresponding value in E2; same for D3, D4, etc.:

If D2 contains "REG_EU", write Europe in E2 and/or
If D2 contains "CN", write China in E2 and/or
If D2 contains "US", write North America in E2 and/or
If D2 contains "REG_WORLD", write North America, Europe and China in E2.

I've included a sample for reference.

Any help would be appreciated. Thanks!
Click to expand...


I think this should get you started.

Code: 
Sub Go()
    cOutput = Empty
    If InStr(1, Range("D2"), "REG_EU") > 0 Then
        cOutput = cOutput & "Europe, "
    End If
    If InStr(1, Range("D2"), "CN") > 0 Then
        cOutput = cOutput & "China, "
    End If
    If InStr(1, Range("D2"), "US") > 0 Then
        cOutput = cOutput & "North America, "
    End If
    If InStr(1, Range("D2"), "REG_WORLD") > 0 Then
        Range("E2") = "North America, Europe, and China"
    End If
    cOutput = Trim(cOutput)
    If Not IsEmpty(cOutput) Then
        If Mid(cOutput, Len(cOutput), 1) = "," Then
            cOutput = Mid(cOutput, 1, Len(cOutput) - 1)
        End If
        Range("E2") = cOutput
    End If
End Sub
 
Upvote 0
Steve_ said:
I think this should get you started.

Code: 
Sub Go()
    cOutput = Empty
    If InStr(1, Range("D2"), "REG_EU") > 0 Then
        cOutput = cOutput & "Europe, "
    End If
    If InStr(1, Range("D2"), "CN") > 0 Then
        cOutput = cOutput & "China, "
    End If
    If InStr(1, Range("D2"), "US") > 0 Then
        cOutput = cOutput & "North America, "
    End If
    If InStr(1, Range("D2"), "REG_WORLD") > 0 Then
        Range("E2") = "North America, Europe, and China"
    End If
    cOutput = Trim(cOutput)
    If Not IsEmpty(cOutput) Then
        If Mid(cOutput, Len(cOutput), 1) = "," Then
            cOutput = Mid(cOutput, 1, Len(cOutput) - 1)
        End If
        Range("E2") = cOutput
    End If
End Sub
Click to expand...

Thank you! This works but only for the first row. I have a range that could contain several rows. Can you please advise how to set a range? Thank you
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG10Jul30
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    .Item(" REG_EU ") = "Europe"
    .Item(" CN ") = "China"
    .Item(" US ") = "North America"
    .Item(" REG_WORLD ") = "North America, Europe, China"

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
        [COLOR="Navy"]If[/COLOR] InStr(1, Dn.Value, K, vbBinaryCompare) > 0 [COLOR="Navy"]Then[/COLOR]
           Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & IIf(Dn.Offset(, 1).Value = "", .Item(K), ", " & .Item(K))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-
Code: 
[COLOR=navy]Sub[/COLOR] MG10Jul30
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    .Item(" REG_EU ") = "Europe"
    .Item(" CN ") = "China"
    .Item(" US ") = "North America"
    .Item(" REG_WORLD ") = "North America, Europe, China"

[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
        [COLOR=navy]If[/COLOR] InStr(1, Dn.Value, K, vbBinaryCompare) > 0 [COLOR=navy]Then[/COLOR]
           Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & IIf(Dn.Offset(, 1).Value = "", .Item(K), ", " & .Item(K))
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] K
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] With

[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...

Hello Mick, thanks this worked! However, I now realize I have blank returns in Column E if the conditions are not met in Column D range. Can you help expand the range and add a condition that if Column C contains "New Specification", write "North America, Europe and China" in E2. Thanks again!

Here's the logic:
If D2 contains "Significant change" and "REG_EU", write Europe in E2 and/or
If D2 contains "Significant change" and "CN", write China in E2 and/or
If D2 contains "Significant change" and "US", write North America in E2 and/or
If D2 contains "Significant change" and "REG_WORLD", write North America, Europe and China in E2. and/or
If C2 contains "New Specification:", write North America, Europe and China.
 
Upvote 0
Please clarify !!
Are you now saying that any row in column "D" must first have "Significant Change" plus one of the other criteria before the code returns an answer in column "E".
And are you also now saying that ,if there is NO answer returned in column "E" from data in column "D", then look for criteria "New Specification" in column "C", and if found return, "North America, Europe and China" in Column "E", or something else ???
 
Upvote 0
MickG said:
Please clarify !!
Are you now saying that any row in column "D" must first have "Significant Change" plus one of the other criteria before the code returns an answer in column "E".
And are you also now saying that ,if there is NO answer returned in column "E" from data in column "D", then look for criteria "New Specification" in column "C", and if found return, "North America, Europe and China" in Column "E", or something else ???
Click to expand...

Mick, correct. If it is easier to first check column C, then column D, the following inputs would apply: Sorry for the change,.

Here's the logic:
If C2 contains "Significantchange" and D2 contains "REG_EU", write Europe in E2 and/or

If C2 contains "Significant change" and D2contains “CN", write China in E2 and/or
If C2 contains "Significant change" and D2contains “US", write North America in E2 and/or
If C2 contains "Significant change" and D2contains “REG_WORLD", write North America, Europe and China in E2 and/or
If C2 contains "New Specification", write NorthAmerica, Europe and China in E2.

The Range can contain several hundred rows.

 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG11Jul06
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    .Item(" REG_EU ") = "Europe"
    .Item(" CN ") = "China"
    .Item(" US ") = "North America"
    .Item(" REG_WORLD ") = "North America, Europe, China"

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
     [COLOR="Navy"]If[/COLOR] InStr(1, Dn.Offset(, -1).Value, "Significant Change") > 0 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] InStr(1, Dn.Value, K, vbBinaryCompare) > 0 [COLOR="Navy"]Then[/COLOR]
           Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & IIf(Dn.Offset(, 1).Value = "", .Item(K), ", " & .Item(K))
        [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]ElseIf[/COLOR] InStr(1, Dn.Offset(, -1).Value, "New Specification") > 0 [COLOR="Navy"]Then[/COLOR]
            Dn.Offset(, 1).Value = "North America, Europe and China"
     [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-
Code: 
[COLOR=navy]Sub[/COLOR] MG11Jul06
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    .Item(" REG_EU ") = "Europe"
    .Item(" CN ") = "China"
    .Item(" US ") = "North America"
    .Item(" REG_WORLD ") = "North America, Europe, China"

[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
   [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
     [COLOR=navy]If[/COLOR] InStr(1, Dn.Offset(, -1).Value, "Significant Change") > 0 [COLOR=navy]Then[/COLOR]
        [COLOR=navy]If[/COLOR] InStr(1, Dn.Value, K, vbBinaryCompare) > 0 [COLOR=navy]Then[/COLOR]
           Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & IIf(Dn.Offset(, 1).Value = "", .Item(K), ", " & .Item(K))
        [COLOR=navy]End[/COLOR] If
     [COLOR=navy]ElseIf[/COLOR] InStr(1, Dn.Offset(, -1).Value, "New Specification") > 0 [COLOR=navy]Then[/COLOR]
            Dn.Offset(, 1).Value = "North America, Europe and China"
     [COLOR=navy]End[/COLOR] If
  [COLOR=navy]Next[/COLOR] K
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] With

[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...

Hi Mick, thanks but the code seems to repeat the output when more than one input value exists in Cell D2. Here's an example:

[TABLE="width: 919"]
<colgroup><col width="101" style="width: 76pt; mso-width-source: userset; mso-width-alt: 3356;"> <col width="69" style="width: 52pt; mso-width-source: userset; mso-width-alt: 2304;"> <col width="353" style="width: 265pt; mso-width-source: userset; mso-width-alt: 11719;"> <col width="491" style="width: 368pt; mso-width-source: userset; mso-width-alt: 16298;"> <col width="211" style="width: 158pt; mso-width-source: userset; mso-width-alt: 6997;"> <tbody>[TR]
[TD="width: 101, bgcolor: transparent"]Column A[/TD]
[TD="width: 69, bgcolor: transparent"]Column B[/TD]
[TD="width: 353, bgcolor: transparent"]Column C[/TD]
[TD="width: 491, bgcolor: transparent"]Column D[/TD]
[TD="width: 211, bgcolor: transparent"]Column F - Macro Output[/TD]
[/TR]
[TR]
[TD="width: 101, bgcolor: transparent"]200000009083[/TD]
[TD="width: 69, bgcolor: transparent"]00008358[/TD]
[TD="width: 353, bgcolor: transparent"]Significant Change: 200000009083 with PFID: 00008358[/TD]
[TD="width: 491, bgcolor: transparent"] Review and either Approve or Reject reports for specification: 200000009083 with PFID: 00008358 Significant change: Complete GHS revisions for specification 200000009083. ||| Substance ID #: 200000009083 ||| US - Significant change due to HAZARDOUS INGREDIENTS ||| US - Significant change due to GHS LABELING (LIST DATA) ||| US - Significant change due to GHS CLASSIFICATION (NA) ||| US - Significant change due to GHS CLASSIFICATION (LIST DATA) ||| REG_WORLD - Significant change due to LE GHS CLASSIFICATION (NA) ||| REG_WORLD - Significant change due to CHEMICAL CHARACTERIZATION ||| REG_EU - Significant change due to HAZARDOUS INGREDIENTS ||| REG_EU - Significant change due to GHS LABELING (LIST DATA) ||| REG_EU - Significant change due to GHS CLASSIFICATION (LIST DATA) ||| CN - Significant change due to HAZARDOUS INGREDIENTS ||| CN - Significant change due to GHS LABELING (LIST DATA) ||| CN - Significant change due to GHS CLASSIFICATION (LIST DATA) ||| |||Note significant change reason. Run corresponding "LINCOLN ELECTRIC RULES" to completion, create reports with languages from generation variants and extract GHS label data, when applicable, for products that require a GHS label.[/TD]
[TD="width: 211, bgcolor: transparent"]Europe, China, North America, North America, Europe, China[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,231
Messages
6,170,885
Members
452,364
Latest member
springate

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top