Loops to find a search term from Sheet 1 in Sheet 2, add all matching values to an Array and Paste the Array

[I3atnumb3rs]

Hello! I'm probably making it way more complicated than it needs to be and can't seem to work it out. Some help with how to go about this would be MUCH appreciated!

I have 1 workbook containing 2 sheets (XR & Issues)

Sheet XR contains 2 Columns A (SearchString) & B (IDKeyArray)

Sheet Issues contains 2 Columns A (IDKey) & B (Labels)

I want to loop through each row of Column A in Sheet XR to see if (SearchString) is found while looping through each row of Column B (Label) in Sheet Issues
Each time the string is found I want to add the Value of Column A (IDKeys) in sheet Issues to an array and then paste the array with all those IDKeys of the array into Column B (IDKeyArray) in Sheet XR


This is what the sheets look like at the start:

Sheet XR:

SearchString IDKeyArray
XR-001
XR-002
XR-003


Sheet Issues:

IDKey Labels
100001 XR-003, reopened, to check, XR-002
100002 XR-001, XR-003 look into, closed
100003 XR-002, reopened, XR-001, Blocked
100004 Reopened, to check, XR-003

And once the code is run I want Sheet XR took look like this:

Sheet XR:

SearchString
XR-001
XR-002
XR-003

IDKeyArray
100002, 100003
100001, 100003
100001, 100004

Horrible not finished code:

Sub StringSearch()

'To search for Strings in XR in Labels in Issues
Sheets("XR").Select
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long


'Uses the ActiveSheet
With ActiveSheet


'Sets the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

'loop from Lastrow to Firstrow (bottom to top)
For Lrow = LastRow To Firstrow Step -1

'We check the values in the A column
With .Cells(Lrow, "A")

If Not IsError(.Value) Then

StringLabelSearch (Cells(Lrow, 1).Value)
'Send Value to StringLabelSearch

End If

End With

Next Lrow

End With


End Sub
Sub StringLabelSearch(XRString)



Sheets("Issues").Select


Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim refConcentrations As Variant
Dim XR As String

XR = XRString

' Init array to a very large size on init >> will optimize at the end of the code
ReDim refConcentrations(1 To 1000) As Variant


'Uses the ActiveSheet
With ActiveSheet


'Sets the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

'loop from Lastrow to Firstrow (bottom to top)
For Lrow = LastRow To Firstrow Step -1

'We check the values in the A column
With .Cells(Lrow, "B")

If Not IsError(.Value) Then

If Cells(Lrow, 1).Value = XR Then
'Return

End If

End With

Next Lrow

End With

ReDim Preserve refConcentrations(1 To j - 1) ' <-- resize array to number of elements found

End Sub

 

[DanteAmor]

Try this:

Sub StringSearch()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant, w As Variant
  Dim dic As Object
  Dim i As Long
  Dim lbl As String
  
  Set sh1 = Sheets("XR")
  Set sh2 = Sheets("Issues")
  Set dic = CreateObject("Scripting.Dictionary")
  
  'SearchString XR sheet
  a = sh1.Range("A2", sh1.Range("A" & Rows.Count).End(3)).Value
  'data from ISUES sheet
  c = sh2.Range("A2", sh2.Range("B" & Rows.Count).End(3)).Value
  'output array
  ReDim b(1 To UBound(a, 1), 1 To 1)
  
  'Stores each word in column B of the Issues sheet in an index.
  For i = 1 To UBound(c, 1)
    lbl = CleanLabel(c(i, 2))
    For Each w In Split(lbl, " ")
      dic(w) = dic(w) & ", " & c(i, 1)
    Next
  Next
  
  'Looks up SearchString in the index and gets the IdKeys.
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 1)) Then
      b(i, 1) = Mid(dic(a(i, 1)), 3)
    End If
  Next
  
  sh1.Range("B2").Resize(UBound(b)).Value = b
End Sub

Function CleanLabel(lbl As Variant) As String
  Dim lbl2 As String
  lbl2 = Replace(lbl, ",", "")
  lbl2 = Replace(lbl2, ";", "")
  CleanLabel = Replace(Trim(lbl2), ".", "")
End Function

-------------
Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.
-------------
NOTE XL2BB:
For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.
-------------
Example:

Dante Amor
	A
1	SearchString
2	XR-001
3	XR-002
4	XR-003
5	XR-004
XR

Dante Amor
	A	B
1	IDKey	Labels
2	100001	XR-003, reopened, to check, XR-002
3	100002	XR-001, XR-003 look into, closed
4	100003	XR-002, reopened, XR-001, Blocked
5	100004	Reopened, to check, XR-003
6	100005	Reopened, to check, XR-004
7	100006	Reopened, to check, XR-005
Issues

After macro:

Dante Amor
	A	B
1	SearchString	IDKeyArray
2	XR-001	100002, 100003
3	XR-002	100001, 100003
4	XR-003	100001, 100002, 100004
5	XR-004	100005
XR

 

[I3atnumb3rs]

oh! I didn't know I could post it in excel format, yes that would have been better, just tried the code it works briilliantly THANK YOU SO MUCH