Append string to cells depending on values in other cells - vba

Question

I am working on a project to scans a list of dates in one column and values in another, and then appends a value to a string in a third column. What I am having trouble with is appending that same value to every cell above the specified date. The data looks like this:
What I need to have happen is for the values of T1, T2 etc. to be appended to the code for every cell above the last_month_row which does not already have a value appended. It should look like this:
My code thus far is this:
Sub Test_Logic()
Dim lastrow As Long, lastcolumn As Long, lastrow_reps As Long
Dim tmp As String, arr() As String, msg As String
Dim cell As Range
Dim i As Integer, j As Integer
Dim last_month As Long
Dim last_month_row As String, first_month_row As String
Dim ws As Worksheet, ws2 As Worksheet
Dim wb As Workbook
Dim reps As Variant, quota As Variant, repslist As Variant, ACV As Variant
Set wb = ActiveWorkbook
Set ws2 = wb.Sheets("Rep_Commission")
lastrow_reps = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set repslist = ws2.Range("A3:A" & (lastrow_reps))
Set ACV = ws2.Range("B3:B" & (lastrow_reps))
With wb
For Each reps In repslist
Set ws = Worksheets(reps.Text)
Set ACV = ws2.Range("A1:A99").Find(reps, LookIn:=xlValues).Offset(, 1)
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For Each cell In ws.Range("I2:I" & lastrow)
If (cell <> "") And (InStr(tmp, cell) = 0) Then
tmp = tmp & cell & "|"
End If
Next cell
If Len(tmp) > 0 Then tmp = Left(tmp, Len(tmp) - 1)
arr = Split(tmp, "|")
For i = LBound(arr) To UBound(arr)
msg = msg & arr(i) & vbNewLine
Next i
For i = LBound(arr) To UBound(arr)
'the error occurs here
last_month = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 6).Value
last_month_row = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Row
first_month_row = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlNext).Offset(, 7).Address
If last_month < (ACV / 2) Then
ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Value = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 5).Value & "T1"
For j = 2 To last_month_row - 1
If ws.Range("I" & j).Value = arr(i) Then
ws.Range("P" & j).Value = ws.Range("P" & j).Value & "T1"
End If
Next j
ElseIf last_month > (ACV / 2) And last_month < ACV Then
ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Value = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 5).Value & "T2"
For j = 2 To last_month_row - 1
If ws.Range("I" & j).Value = arr(i) Then
ws.Range("P" & j).Value = ws.Range("P" & j).Value & "T2"
End If
Next j
ElseIf last_month > ACV And last_month < (ACV * 1.5) Then
ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Value = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 5).Value & "T3"
For j = 2 To last_month_row - 1
If ws.Range("I" & j).Value = arr(i) Then
ws.Range("P" & j).Value = ws.Range("P" & j).Value & "T3"
End If
Next j
ElseIf last_month > (ACV * 1.5) Then
ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Value = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 5).Value & "T4"
For j = 2 To last_month_row - 1
If ws.Range("I" & j).Value = arr(i) Then
ws.Range("P" & j).Value = ws.Range("P" & j).Value & "T4"
End If
Next j
Else 'Do nothing yet, or maybe some error handling??
End If
Next i
Next reps
End With
End Sub
What I can't figure out is how to add the "T" values to the correct cells - I tried looping through a range created by first_month_row and last_month_row but ended up just appending multiples of the T values. Any advice would be appreciated.
EDIT: So I was successfully able to populate the cells, but when I try to loop through my worksheets I get an "Object Variable or With block Variable Not Set" Error. It occurs at this line:
last_month = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 6).Value
But last_month is a single value, not an object so I don't see why this is occurring.

Answer 1

Your sub does exactly what you have programmed. It finds the last occurence of arr(i) and sets the value in column P for the last row only. You'd rather loop this way to go through the ranges with the same date:
Dim last_month_row as long, first_month_row as long, k as long
For i = LBound(arr) To UBound(arr)
last_month_row = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).row
first_month_row = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlNext).Offset(, 7).row
For k = first_month_row to last_month_row
If last_month < (ACV / 2) Then
ws.cells(k, "P").Value = ws.cells(k, "N").Value & "T1"
...
Additionally, I suggest using Long instead of Integer. VBA works with longs, you do not save anything with integers, but you risk an overflow going above 65K.

Answer 2

I think you need to add another Array/Collection that contains "ONLY" the "Unique" values for column "I", then use this Unique values to iterate/search inside your selection as the following pseudo code:
For Each Unq in UniqueDate
For i = LBound(arr) To UBound(arr)
// Here, use "Unq" instead of "arr(i)" to search/find your target value
next i
next Unq
For me, the easiest way to create a unique 'list' is by using "Collection" :
Dim UniqDate As New Collection
ws.Range("I2:I" & lastrow).Select
If Not Selection Is Nothing Then
For Each cell In Selection
UniqDate.Add cell, cell // Collection will ignore the value of "cell" if already exist (duplicated values filtering)
// the rest of your code is the same
If (cell <> "") And (InStr(tmp, cell) = 0) Then
tmp = tmp & cell & "|"
End If
Next cell
End If