Macro to return value if cell contains certain text

dan4

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

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,200
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
 

Steve_

Board Regular
Joined
Apr 28, 2010
Messages
167
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!

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
 

dan4

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

MickG

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

dan4

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

MickG

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

dan4

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

 

MickG

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

dan4

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

Column AColumn BColumn CColumn DColumn F - Macro Output
20000000908300008358Significant Change: 200000009083 with PFID: 00008358 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.Europe, China, North America, North America, Europe, China
<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> </tbody>
 

Watch MrExcel Video

Forum statistics

Threads
1,102,869
Messages
5,489,376
Members
407,686
Latest member
Chuck1960

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top