Find If cell matches in another sheet and count/sum instances - vba

Question

I have been using simple excel array formulas to count certain values on a master sheet but now at the point where I have too many formulas in my document and excel is crashing.
Therefore, I would like to create a macro that can do the same task. I would like to have the code do the following:
IF the activecell in Sheet1 matches to any cell in a column(or range) in Sheet2,
AND IF the cell in the same row in an adjacent column in Sheet2 is not blank,
THEN count all the instances that specific string appears in Sheet2 column A
AND place the value 2 columns to the right of the original active cell in Sheet1.
Here is the original array formula I was using:
=SUM(IF(Sheet1!$A8=Sheet2!$A:$A,IF(SalesF_SignUp_data!$C:$C>1,1,0)))
The formula above is taking the cell A8 in Sheet1 and checking if it matches to any cell in Sheet2 column A,
AND making sure that column C in Sheet2 is not blank in the same row.
If this is TRUE then "add 1" for all the instances
AND place that value in Sheet1.
I believe the best way to do this is a For Next Loop but haven't been able to execute any successful code based on examples I've found.
Im happy to explain further if needed. Since I dont have a reputation of 10 I cant attach images but am willing to send if needed.

Answer 1

This is set up to run for all the cells you've selected in column A of sheet 1.
It looks in Sheet2 column A for the value on Sheet1 column A, then in Sheet1 column B, displays how many times the value appeared in Sheet2 column A along with a value in the same row of column C.
If the answer is helpful, please mark it as such. :-)
Option Explicit
Sub countinstances()
Dim result, counter, loopcount, tocomplete, completed As Integer
Dim findtext As Variant
Dim cell, foundcell, nextcell As Range
'Checks to make sure the sub isn't accidentally run on an invalid range
If ActiveSheet.Name <> "Sheet1" Or ActiveCell.Column <> 1 Or Selection.Columns.Count > 1 Then
MsgBox ("Please select a range in column A of Sheet 1.")
Exit Sub
End If
'In case of selecting the entire column A, curtail the number of blank cells it runs on.
tocomplete = Application.WorksheetFunction.CountA(Selection)
completed = 0
'For each cell in the selected range, searches Sheet2, Column A for the value in the selected cell
For Each cell In Selection
If completed = tocomplete Then Exit Sub
If cell.Value <> "" Then completed = completed + 1
findtext = cell.Value
result = 0
Set foundcell = Sheets("Sheet2").Range("A1")
'Uses the count function to determine how many instances of the target value to search for and check
loopcount = Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), findtext)
'Skips the loop if the target value doesn't exist in column A
If loopcount = 0 Then GoTo NotFound
'For each time the target value was found, check the cell in column C. If it's not blank, increment "result"
For counter = 1 To loopcount
Set nextcell = Sheets("Sheet2").Range("A:A").Find(what:=findtext, lookat:=xlWhole, after:=foundcell)
If nextcell.Offset(0, 2).Value <> "" Then
result = result + 1
End If
Set foundcell = nextcell
Next
'Put the result in column B of Sheet1
NotFound:
cell.Offset(0, 1).Value = result
Blanks:
Next
End Sub