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]
 
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG12Jul22
[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, Sp [COLOR="Navy"]As[/COLOR] Variant, nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[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
     nStr = ""
     [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]
           [COLOR="Navy"]If[/COLOR] K = " REG_WORLD " [COLOR="Navy"]Then[/COLOR]
                 Sp = Split(.Item(K), ", ")
                 [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
                    [COLOR="Navy"]If[/COLOR] InStr(Dn.Offset(, 1).Value, Sp(n)) = 0 [COLOR="Navy"]Then[/COLOR]
                        nStr = nStr & IIf(nStr = "", Sp(n), ", " & Sp(n))
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] n
           [COLOR="Navy"]Else[/COLOR]
                nStr = .Item(K)
           [COLOR="Navy"]End[/COLOR] If
           
           Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & IIf(Dn.Offset(, 1).Value = "", nStr, ", " & nStr)
        [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

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
MickG said:
Try this:-
Code: 
[COLOR=navy]Sub[/COLOR] MG12Jul22
[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, Sp [COLOR=navy]As[/COLOR] Variant, nStr [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[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
     nStr = ""
     [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]
           [COLOR=navy]If[/COLOR] K = " REG_WORLD " [COLOR=navy]Then[/COLOR]
                 Sp = Split(.Item(K), ", ")
                 [COLOR=navy]For[/COLOR] n = 0 To UBound(Sp)
                    [COLOR=navy]If[/COLOR] InStr(Dn.Offset(, 1).Value, Sp(n)) = 0 [COLOR=navy]Then[/COLOR]
                        nStr = nStr & IIf(nStr = "", Sp(n), ", " & Sp(n))
                    [COLOR=navy]End[/COLOR] If
                [COLOR=navy]Next[/COLOR] n
           [COLOR=navy]Else[/COLOR]
                nStr = .Item(K)
           [COLOR=navy]End[/COLOR] If
           
           Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & IIf(Dn.Offset(, 1).Value = "", nStr, ", " & nStr)
        [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, you almost have it. Is it possible to prevent the last comma after China when D2 has repeating text inputs? It works great when D2 has one text input reference. Here is an example. The reason I ask is because I will filter Column E and would like consent returns Thank for your help.

[TABLE="width: 960"]
<colgroup><col width="120" style="width: 90pt; mso-width-source: userset; mso-width-alt: 3982;" span="2"> <col width="200" style="width: 150pt; mso-width-source: userset; mso-width-alt: 6627;"> <col width="457" style="width: 343pt; mso-width-source: userset; mso-width-alt: 15160;"> <col width="189" style="width: 142pt; mso-width-source: userset; mso-width-alt: 6286;"> <col width="194" style="width: 145pt; mso-width-source: userset; mso-width-alt: 6428;"> <tbody>[TR]
[TD="width: 120, bgcolor: transparent"]200000003975[/TD]
[TD="width: 120, bgcolor: transparent"]00005923[/TD]
[TD="width: 200, bgcolor: transparent"]Significant Change Specification: 200000003975 with PFID 00005923[/TD]
[TD="width: 457, bgcolor: transparent"] Significant change: Complete GHS revisions for specification 200000003975. ||| Substance ID #: 200000003975 ||| US - Significant change due to HAZARDOUS INGREDIENTS ||| REG_EU - Significant change due to HAZARDOUS INGREDIENTS ||| CN - Significant change due to HAZARDOUS INGREDIENTS ||| [/TD]
[TD="width: 189, bgcolor: transparent"]North America, Europe, China[/TD]
[TD="width: 194, bgcolor: transparent"]D2 has one of each "US", "REG_EU", CN[/TD]
[/TR]
[TR]
[TD="width: 120, bgcolor: transparent"]200000009182[/TD]
[TD="width: 120, bgcolor: transparent"]00008697[/TD]
[TD="width: 200, bgcolor: transparent"]Significant Change Specification: 200000009182 with PFID 00008697[/TD]
[TD="width: 457, bgcolor: transparent"] Significant change: Complete GHS revisions for specification 200000009182. ||| Substance ID #: 200000009182 ||| 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) ||| [/TD]
[TD="bgcolor: transparent"]North America, Europe, China, [/TD]
[TD="width: 194, bgcolor: transparent"]D2 has multiple "US", "REG_EU", CN. Notice the comma after CN[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Add the 2 lines below shown in red:-
Code: 
 End If
          [COLOR="#FF0000"][B] If Not nStr = "" Then
[/B][/COLOR]           Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & IIf(Dn.Offset(, 1).Value = "", nStr, ", " & nStr)
       [COLOR="#FF0000"][B]    End If
[/B][/COLOR]        End If
 
Last edited:
Upvote 0
MickG said:
Add the 2 lines below shown in red:-
Code: 
 End If
          [COLOR=#ff0000][B] If Not nStr = "" Then
[/B][/COLOR]           Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & IIf(Dn.Offset(, 1).Value = "", nStr, ", " & nStr)
       [COLOR=#ff0000][B]    End If
[/B][/COLOR]        End If
Click to expand...

It worked! Thank you so much for your help. I really appreciate it1
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,231
Messages
6,170,884
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