Macro to Search(Find) specific word from list, and copy a cell referenced from each

Problem: I have a list in Sheet1 ("Main") in Column X that is dynamic in length every time I run the program. The list will be used as the search parameter for each search until the list has ended.
I would like the program then to start with the first row in Sheet 1 Column X as the search term, ie: Morrison Maierle and then search Sheet 2 ("NoRetention") for the match throughout the sheet in column K, and each time it finds word I would like it to reference a cell that is 8 column away from it in column S.

Keep doing this for every instance of the word and then total up the amounts in Column S.

Solution: I have thought up so far a solution that does not work but I think is close to there. I have written it out to copy all cells into Column W. What I have not done is make it total up everything in Column Y and place that amount in the same row as the name it search Morrison Maierle in Column Y.

Goal: When the program is done I have a neat list of column X companies, and column Y of total amounts it found in Sheet2("NoRetention") that were added up from Column W.

Code so far:

Sub SearchForReceivedAmt()
    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim rngFound As Range
    Dim strFind As String
    Dim strFirst As String
    Dim counter As Integer
    Dim pastecounter As Integer
    
    Set wsData = Sheets("NoRetention")
    Set wsDest = Sheets("Main")
    pastecounter = 1
    businesscounter = 1
    
    strFind = Sheet1.Cells(businesscounter, "X").Text
    
wsDest.Cells(1, "X").Activate
Do Until ActiveCell Is Nothing
        Set rngFound = wsData.Range("K:K").Find(What:=strFind, After:=ActiveCell, LookIn:=xlValues, Lookat:=xlPart)
        If Not rngFound Is Nothing Then
            ActiveCell.Offset(0, 8).Activate
            ActiveCell.Copy
            wsDest.Cells(pastecounter, "W").Paste
            wsData.Activate
            ActiveCell.Offset(0, -8).Activate
            pastecounter = pastecounter + 1
            businesscounter = businesscounter + 1
        Else
            Exit Sub
        End If
        Set rngFound = Nothing
        Loop
        wsDest.Activate
        ActiveCell.Offset(1, 0).Activate
        Loop
        
Err_handle:         Exit Sub
        
End Sub

Also have attached a sample test book of the problem.

Should these two functions of adding and collecting the data be combined into two subs?

Are you adding up column S, not W since you do not have data in column W?

Yes AB33, I am trying to add up column S with the rows that correlate with the search parameter in column K.

Try the attached.

It works flawlessly holy hell!

Thank you AB33, you a coffee drinker? I will make it a goal to find a way to send you a cup of coffee on me at your local starbucks


In the mean time it is pissing me off that I do not understand your code.

 With Worksheets("NoRetention")
    x = .Range("K1:S" & .Range("K" & .Rows.Count).End(xlUp).Row)
 End With

**This declares the range to be X as the searchable field in "NoRetention" as K1 to the end of column K and including column S

The next part is a little archaic to me, do you create a Scripting Dictionary to hold all the values of each company and then use the dictionary to do math?

I have never seen something look like this, as my example is much much different. Is this kind of information/knowledge a relatively basic programming step?

AB33 I have gone and taken your code and think I learn more of the scripting dictionary. I wanted to try and create your program onto another sheet to do darn near the same thing. So I tweaked the column references inside the array to accommodate the different sheet.

This looks like it would work, the biggest difference in this list is that the list now might not contain the name from the main list. The code I have from you that is altered:

Sub GetRetainageAmt()
   Dim x, i As Long, k As Long  'Declarations


 With Worksheets("OnlyRetention")
    x = .Range("J1:R" & .Range("J" & .Rows.Count).End(xlUp).Row)
 End With
 
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 4 To UBound(x)
        If Len(x(i, 1)) Then
           If Not .exists(x(i, 1)) Then
             ReDim Z(1 To 1)
               Z(1) = x(i, 8)
                .Item(x(i, 1)) = Z
           Else
                Z = .Item(x(i, 1))
                Z(1) = Z(1) + x(i, 8)
               .Item(x(i, 1)) = Z
           End If
        End If
    Next i
        With Worksheets("Main")
           x = .Range("X1:Z" & .Range("X" & .Rows.Count).End(xlUp).Row)
        End With
 
  For i = 1 To UBound(x)
       If Len(x(i, 2)) Then
           If .exists(x(i, 2)) Then
                k = k + 1
                x(k, 2) = .Item(x(i, 2))(1)
           End If
       End If
  Next
End With
       With Worksheets("Main")
          .Range("Z1:W" & .Rows.Count).ClearContents
          If k > 0 Then .Range("Z1").Resize(k, 1) = x
       End With
    
End Sub

Attached is a updated Test Excel File to view the new sheet that was added.

Shouldent this script modified to another worksheet work? However right now it just deletes my columns in my main sheet.