PDA

View Full Version : [SOLVED] Find values within strings from a predefined list



lads11
06-28-2015, 11:36 PM
Hi,

I have a 'List of things', and want to identify each cell in that list that contains any item my other list 'Things to find', and place the 'Things to find's unique ID next to the cell of the 'List of things'

This is a simplified version of what I am using, with the ID for John and Mary inserted next to the cells that contain them (if indeed I could get this to work!):



List of things

Place the ID here

Things to find

Unique Things IDs



John's place

B

Bill

A



something about mary

F

John

B



somewhere else1


James

C



somewhere else2


Steve

D



John's other place

B

Aaron

E





Mary

F





Thomas

G





The closest solution I have found enables me to place a name from my 'Thing to find' list next to the 'List of things' if it exists anywhere in the strings in the 'List of things' - IF THE LIST IS SHORT.

However my issue is that my 'Things to find' list is 8,000 long, and I am unable to alter the code to use an array of that length (rather than say a list of names separated by commas)

Any assistance would be very much appreciated.

lads11
06-29-2015, 12:08 AM
This is the code that I have at the moment:


Sub Mark_cells_in_column()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim I As Long
Dim ws As Worksheet
Set ws = Sheets("Test Activities")

With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Search for a Value Or Values in a range
'this is a problem - code works if array is specified as a single value - eg myarr = array("John") or myarr = array("John", "Mary")
MyArr = Array("John")
'Search Column or range
With Sheets("Test_sheet").Range("A2:A31")
'clear the cells in the column to the right
.Offset(0, 1).ClearContents
For I = LBound(MyArr) To UBound(MyArr)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "ron"
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
'mark the cell in the column to the right if "Ron" is found
'I changed to MyArr(I) rather than "X"

Rng.Offset(0, 1).Value = MyArr(I)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

snb
06-29-2015, 01:14 AM
Since John's isn't an item in the list 'things to find' your example isn't correct.

SamT
06-29-2015, 05:45 AM
Something about Mary is OK, but John's Place isn't?

What about

Something about Mary in John's Place?

SamT
06-29-2015, 05:56 AM
I changed the array to a cell in Things To Find

Sub Mark_cells_in_column()
Dim FirstAddress As String
Dim Cel
Dim Rng As Range
Dim I As Long
Dim ws As Worksheet
Set ws = Sheets("Test Activities")

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Search for a Value Or Values in a range
'this is a problem - code works if array is specified as a single value - eg myarr = array("John") or myarr = array("John", "Mary")

With Sheets("Test_sheet").Range("A2:A31")
'clear the cells in the column to the right
.Offset(0, 1).ClearContents
For Each Cel In Range(Range("D2"), Range("D2").End(xlDown))
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "ron"
Set Rng = .Find(What:=Cel.Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
'mark the cell in the column to the right if "Ron" is found
'I changed to MyArr(I) rather than "X"

Rng.Offset(0, 1).Value = Cel.Offset(0, 1).Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next Cel
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

lads11
06-29-2015, 05:10 PM
SamT, thank you so much. A simple but powerful change, I just needed to tweak the column references and it works. Kind regards, lads11

snb
06-30-2015, 12:37 AM
or you could use VBA:


Sub M_snb()
sn = [C2:D8]
sp = [A2:B6]

For j = 1 To UBound(sn)
For jj = 1 To UBound(sp)
If InStr(sn(j, 1), sp(jj, 1)) Then sp(j, 2) = sp(j, 2) & sn(j, 2)
Next
Next

[A2:B6] = sp
End Sub