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
Since John's isn't an item in the list 'things to find' your example isn't correct.
Something about Mary is OK, but John's Place isn't?
What about
Something about Mary in John's Place?
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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.