View Full Version : Search Characters Within String
barim
01-11-2019, 01:41 PM
I would like to have either formula or VBA that could perform the following:
Search for the string from the list based on search parameters that are located at G2:K2. I need to search column A for all string combinations that contain characters typed in search boxes. For example, LZAAI the result should be AAZLI, LAAZI, LIAZA. If I erase letter I it should return ZAAL, AALZ or any combination that is on the list. So, the positions of the search characters don’t matter as long as they are contained completely inside the codes from the list. I don’t care if results are filtered out, highlighted or copied below search boxes, I just need to see these codes that match criteria. Also, anything that is greater than a number of searched characters should not be shown in the search results. If I erase one letter the results should not show codes greater than 4 characters etc. I am attaching workbook to make it more clear. I hope this is not too much of a headache. Thank you!
23545
akuini
01-17-2019, 08:17 AM
I would like to have either formula or VBA that could perform the following:
Try this:
Sub c64409c()
'http://www.vbaexpress.com/forum/showthread.php?64409-Search-Characters-Within-String
Dim r As Range
Dim i As Long, j As Long, x As Long
Dim va, vb
Dim flag As Boolean
Set r = Range("A1", Cells(Rows.count, "A").End(xlUp))
va = r
r.Interior.Color = xlNone
vb = Range("G2:K2")
For i = 1 To UBound(vb, 2)
x = x + Len(vb(1, i))
Next
For i = 1 To UBound(va, 1)
flag = True
For j = 1 To UBound(vb, 2)
If Len(vb(1, j)) = 1 Then
If InStr(va(i, 1), vb(1, j)) = 0 Or Len(va(i, 1)) <> x Then
flag = False: Exit For
End If
End If
Next
If flag = True Then
Cells(i, "A").Interior.Color = vbYellow
End If
Next
End Sub
barim
01-24-2019, 12:36 PM
Thank you so much for your response. This helps a lot. I am also thinking about something. Would it be possible to have all permutations of characters. For example, ABC should produce: ACB, BAC, CBA, CAB. Number of characters should depend what I enter in the criteria cells. If I enter ABCDE it should perform permutation on all 5 characters. Thank you!
akuini
01-25-2019, 02:32 AM
Thank you so much for your response. This helps a lot. I am also thinking about something. Would it be possible to have all permutations of characters. For example, ABC should produce: ACB, BAC, CBA, CAB. Number of characters should depend what I enter in the criteria cells. If I enter ABCDE it should perform permutation on all 5 characters. Thank you!
Sorry, actually my code above is flawed.
Try typing AZZA, it will highlight ZAAL,IAZA,AALZ.
So try this one instead:
Sub c64409d()
'http://www.vbaexpress.com/forum/showthread.php?64409-Search-Characters-Within-String
Dim r As Range, tx As String
Dim i As Long, j As Long, x As Long
Dim va, vb
Dim flag As Boolean
Set r = Range("A1", Cells(Rows.count, "A").End(xlUp))
va = r
r.Interior.Color = xlNone
vb = Range("G2:K2")
For i = 1 To UBound(vb, 2)
x = x + Len(vb(1, i))
Next
For i = 1 To UBound(va, 1)
flag = True
tx = va(i, 1)
For j = 1 To UBound(vb, 2)
If Len(vb(1, j)) = 1 Then
If InStr(tx, vb(1, j)) = 0 Or Len(tx) <> x Then
flag = False: Exit For
End If
n = InStr(tx, vb(1, j))
tx = WorksheetFunction.Replace(tx, n, 1, "~")
End If
Next
If flag = True Then
Cells(i, "A").Interior.Color = vbYellow
End If
Next
End Sub
About the permutation, I don't know how to do that. I think you may want to start a new thread for that.
JimmyTheHand
01-25-2019, 05:43 AM
I borrowed akuini's code and modified it a bit. Try this. It should take care of permutations as well. (Assuming that I got the question right.)
Sub c64409d_mod()
'http://www.vbaexpress.com/forum/showthread.php?64409-Search-Characters-Within-String
Dim sFiltCodes As String
Dim c As Range
Dim rLookup As Range, arrLookup
Dim Counter As Long, i As Long, j As Long
For Each c In Range("G2:K2")
sFiltCodes = sFiltCodes & c.Value
Next
Set rLookup = Range("A1", Range("A" & Rows.Count).End(xlUp))
rLookup.Interior.Color = xlNone
arrLookup = rLookup.Value
For i = LBound(arrLookup, 1) To UBound(arrLookup, 1)
Counter = 0
For j = 1 To Len(sFiltCodes)
If InStr(arrLookup(i, 1), Mid(sFiltCodes, j, 1)) > 0 Then
Counter = Counter + 1
arrLookup(i, 1) = Replace(arrLookup(i, 1), Mid(sFiltCodes, j, 1), "", 1, 1)
End If
Next
If (Counter = Len(sFiltCodes)) And (arrLookup(i, 1) = "") Then Cells(i, "A").Interior.Color = vbYellow
Next
End Sub
大灰狼1976
01-25-2019, 06:41 PM
Thank you so much for your response. This helps a lot. I am also thinking about something. Would it be possible to have all permutations of characters. For example, ABC should produce: ACB, BAC, CBA, CAB. Number of characters should depend what I enter in the criteria cells. If I enter ABCDE it should perform permutation on all 5 characters. Thank you!
Hi barim!
maybe this is helpful to you :
Private Sub test()
Dim s$, n&, i&, arr
s = InputBox("")
n = Len(s)
ReDim arr(1 To 1, 1 To 1): arr(1, 1) = Right(s, 1)
For i = n - 1 To 1 Step -1
arr = trans(arr, Mid(s, i, 1))
Next i
[a1].CurrentRegion.ClearContents
[a1].Resize(UBound(arr)) = arr
End Sub
Function trans(ByVal arr, ByVal s1)
Dim arr1, i&, j&, n&, ln&, r&
n = UBound(arr)
ln = Len(arr(1, 1))
ReDim arr1(1 To n * (ln + 1), 1 To 1)
For j = 0 To ln
For i = 1 To n
r = r + 1
arr1(r, 1) = Left(arr(i, 1), j) & s1 & Right(arr(i, 1), ln - j)
Next i
Next j
trans = arr1
End Function
大灰狼1976
01-25-2019, 06:45 PM
Note: when 10 characters, the number of combinations will reach more than 3 million,can't output into columns( rows.count = 1048576 ).
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.