Lookup dates and calculate expiratrion - vba

Question

I have two data reports where I sort the data in data report 1 and move it to a sheet called "List". To finish off the report I then,
Get a date from data report two for every line I have in the sorted list. To do this I have tried to take the action title in column "G" in the sheet "List" and then I search for it in the sheet "Data2" in column "C", then I return the row number and want to save a number there is in the column "G". This number is the days to deadline and can either be a positive or negative number.
Take today's date + / - the number and put the modified date and the sheet "Lists" in column "N" to be able to see when every task has deadline.
I can't get other kinds of data in the reports so I have to solve this with some VBA. The code I have tried is this.
Sub InsertDate()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Integer
Dim RowNr As Long
Dim ActionTitle As String
Dim DaysToExp As Long
Dim ExpDate As Date
Dim Found As Range
Dim FoundRow As Long
Dim Sign As String
Dim Days As String
Dim RowNr2 As Long
ScreenUpdate = False
RowNr = ThisWorkbook.Worksheets("List").Range("A" & Rows.count).End(xlUp).row
RowNr2 = ThisWorkbook.Worksheets("Data2").Range("A" & Rows.count).End(xlUp).row
Set ws1 = ThisWorkbook.Worksheets("List")
Set ws2 = ThisWorkbook.Worksheets("Data2")
ws1.Range("N1").Value = "Expected start date"
For i = 2 To RowNr
ActionTitle = ws1.Range("G" & i).Value
Set Found = ws2.Range("C1:C" & RowNr2).Find(What:=ActionTitle, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Activate
FoundRow = ActiveCell.row
Days = ws2.Range("G" & FoundRow).Value
If Days = "" Then
DaysToExp = DaysToExp + 0
ElseIf Left(Days, 1) = "-" Then
Sign = "-"
DaysToExp = Replace(Days, "-", "")
Else
Sign = "+"
DaysToExp = DaysToExp + Days
End If
ExpDate = "=TODAY() & Sign & DaysToExp"
ThisWorkbook.Worksheets("List").Range("N" & i).Value = ExpDate
Next i
ScreenUpdate = True
End Sub

Answer 1

I've tightened up your code a bit and removed the .Find in place of a worksheet function .Match. You don't need to parse out the sign of Days since you can add a negative number to the date.
Sub InsertDate()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long
Dim RowNr As Long, DaysToExp As Long, FoundRow As Long, RowNr2 As Long
Dim ActionTitle As String, Sign As String, Days As String
Dim ExpDate As Date
Dim Found As Range
Application.ScreenUpdating = False
Set ws1 = ThisWorkbook.Worksheets("List")
Set ws2 = ThisWorkbook.Worksheets("Data2")
RowNr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
With ws1
RowNr = .Range("A" & Rows.Count).End(xlUp).Row
.Range("N1").Value = "Expected start date"
For i = 2 To RowNr
ActionTitle = ws1.Range("G" & i).Value
If CBool(Application.CountIf(ws2.Range("C1:C" & RowNr2), ActionTitle)) Then
FoundRow = Application.Match(ActionTitle, ws2.Range("C1:C" & RowNr2), 0)
Days = ws2.Range("G" & FoundRow).Value
ExpDate = Date + Days
.Range("N" & i).Value = ExpDate
Else
Debug.Print "missing " & ActionTitle
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
I threw a debug.print in that will report to the VBE's Immediate window if ActionTitle cannot be found.