Search Characters Within String

[barim]

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]

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]

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]

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]

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]

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]

Note: when 10 characters, the number of combinations will reach more than 3 million，can't output into columns( rows.count = 1048576 ).