Macro to return value if cell contains certain text

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

dan4

New Member
Joined
Nov 23, 2010
Messages
31
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>
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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:

dan4

New Member
Joined
Nov 23, 2010
Messages
31
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
 

Watch MrExcel Video

Forum statistics

Threads
1,101,817
Messages
5,483,080
Members
407,377
Latest member
JennaWashburn

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top