Macro to return value if cell contains certain text

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!

SUBID
PFID
Short Description
Long Description
Impacted Region
200000002401
00004346
Significant Change Specification: 200000002401 with PFID 00004346
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.
China
200000002402
00004397
Significant Change Specification: 200000002402 with PFID 00004397
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.
North America, Europe, China
200000002411
00004850
Significant Change Specification: 200000002411 with PFID 00004850
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.
Europe, China

<tbody>
</tbody>
 
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

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
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

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.

20000000397500005923Significant Change Specification: 200000003975 with PFID 00005923 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 ||| North America, Europe, ChinaD2 has one of each "US", "REG_EU", CN
20000000918200008697Significant Change Specification: 200000009182 with PFID 00008697 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) ||| North America, Europe, China, D2 has multiple "US", "REG_EU", CN. Notice the comma after CN
<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> </tbody>
 
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
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

It worked! Thank you so much for your help. I really appreciate it1
 
Upvote 0

Forum statistics

Threads
1,214,834
Messages
6,121,877
Members
449,056
Latest member
ruhulaminappu

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