VBA Multiple Criteria and VLoopUp

Hi Guys,

Im am trying to make a code that can help me automate the making of contracts. Im on the right track but it seems like it's still lacking a bit of code.

In plain English this is want my code to do:

1: Read the variable "AptCode" and check if is the C-column on sheet shTenants
2: If AptCode is found in in the C-column test if that same line has the "ACTIVE" status found in Column F in shTenants
3: If both of the conditions are met, being AptCode and Active, then VLookup and print Tenant_Name and FavColor to cell A5:G9
4: Loop for all matches

I would like the the code to return the following:

"Batman likes the color Black, and Barbie Girl likes the color Pink"

Problem no.1: Crocodile Dundee no longer lives in the apartment since the status has been marked as TERMINATED
Problem no.2: The code only writes the data of Batman and not of Barbie Girl. It lacks the loop.


Can you guys help me? This is my very first VBA project!

Here's my code:

Option Explicit
Sub ContractGenerator2()

'Defining variables BEGIN
    Dim AptCode As Long
        AptCode = shContract.Cells(4, 3)
    Debug.Print AptCode
    
    Dim Last_Row As Long
        Last_Row = shTenants.Cells(shTenants.Rows.Count, 1).End(xlUp).Row
    Debug.Print Last_Row
        
            Dim iRange As Long
                For iRange = 2 To Last_Row
                                        
    Dim Tenant_Names As String
        Tenant_Names = Application.VLookup(AptCode, shTenants.Range("C:F"), 2, False)
    Debug.Print Tenant_Names
    
    Dim FavColor As String
        FavColor = Application.VLookup(AptCode, shTenants.Range("C:F"), 3, False)
    Debug.Print FavColor
'Defining variables END


'Code BEGIN
  
            If shTenants.Range("C" & iRange).Value = AptCode Then
                If shTenants.Range("F" & iRange).Value = "ACTIVE" Then
                shContract.Range("A5:G6") = Tenant_Names & " likes the color " & FavColor
                End If
            End If
        Next
End Sub

'Code END

Hi Jacob and welcome to the forum,

Here's a suggestion. The code is slightly different then your but I put some comments for your understanding.

Sub SmallTest2()
   Dim AptCode As Long
   Dim ar
   Dim i As Long
   Dim str As String
   
   'get the app. number
   AptCode = shContract.Cells(4, 3).Value
   
   'store the values in a array for faster processing
   ar = shTenants.Cells(1).CurrentRegion.Value
   
   'loop through the array, starting at row 2 (row 1 = header)
   For i = 2 To UBound(ar, 1)
      'if both conditions are met
      If ar(i, 3) = AptCode And ar(i, 6) = "ACTIVE" Then
         'store in a string
         str = str & ar(i, 4) & " like the color " & ar(i, 5)
         'add " and " for possible other match
         str = str & " and "
      
      End If
   Next i
   
   ' remove last 5 characters ( " and ")
   str = Left(str, Len(str) - 5)
   ' output to cells A5
   shContract.Range("A5").Value = str
   
End Sub

Sub test()

With Sheets("Data Tenants")
LR = .Cells(Rows.Count, 1).End(xlUp).Row
MyArray = .Range("A2:F" & LR).Value
End With

For Count = 1 To LR - 1

If MyArray(Count, 3) <> "" And MyArray(Count, 6) = "ACTIVE" Then

    Sheets("Contract Template").Copy Before:=Sheets(1)
    ActiveSheet.Name = "Contract - " & MyArray(Count, 3) & " - " & MyArray(Count, 4)

    Range("C4").Value = MyArray(Count, 3)
    Range("A5").Value = MyArray(Count, 4) & " Likes the color " & MyArray(Count, 6)
    
End If

Next
End Sub