Insert a row in a data table at a special position under conditions - excel

Question

I've been working on the development of a tool that is supposed to help me manage some projects.
I have a table of data called t_data.
This data table contains every projects. Each project is devided on quarters (Q1 2019, Q2 2019, Q3 2019, etc.). Each quarter is devided on deliverables (not always the same number of deliverables so not the same amount of rows for each quarter).
I have a form in another sheet (name of the sheet: MENU!) that permits to add a new deliverable to a Quarter of a project, and where I put the necessary inputs so that I can find the good raw where I should insert my deliverable. The inputs are the project's name (in MENU!D10) and the quarter concerned by the deliverable (in MENU!D12).
Here is my code :
Sub ajouter_un_livrable()
'
' ajouter_un_livrable Macro
' Ajoute un livrable en fonction de son challenge et de son trimestre.
'
Dim result As Variant
match_formula = "EQUIV(1;(t_data[Associated_challenge] = MENU!$D$10)*(t_data[Associated_quarter] = MENU!$D$12);0)"
result = Evaluate(match_formula)
numero_ligne = CLng(result)
numero_ligne = numero_ligne - 2003
Worksheets("TRT RTI Challenges").Rows(numero_ligne).insert
'Set datasheet = Worksheets("TRT RTI Challenges").ListObjects("t_data")
'With datasheet
'.Cells(numero_ligne, 10).Select
'Selection.ListObject.ListRows.Add (numero_ligne)
'Set myNewDeliverable = .ListRows.Add(numero_ligne)
'End With
'
End Sub
You'll notice I'm french ehe
numero_ligne sounds to return the number 2015 because I have an error 2015... great !
I don't know how to manage the EVALUATE. How can I take its value into a variable ? I've tried a lot of things, consult a lot of forums but nothing's working :'(
Do you have an idea of how I could solve my issue ?
Thanks a lot to the one or those that will help me or at least try. :D

Answer 1

I believe something like this should work for you:
Sub ajouter_un_livrable()
Dim wsInput As Worksheet
Dim rProjects As Range
Dim rQuarters As Range
Dim rFound As Range
Dim vProject As Variant
Dim vQuarter As Variant
Dim sProjectCell As String
Dim sQuarterCell As String
Dim sFirst As String
Dim bMatch As Boolean
sProjectCell = "D10"
sQuarterCell = "D12"
On Error Resume Next
Set wsInput = ActiveWorkbook.Worksheets("MENU")
Set rProjects = Range("t_Data").ListObject.ListColumns("Associated_challenge").DataBodyRange
Set rQuarters = Range("t_Data").ListObject.ListColumns("Associated_quarter").DataBodyRange
On Error GoTo 0
If wsInput Is Nothing Or rProjects Is Nothing Or rQuarters Is Nothing Then
MsgBox "Unable to find a worksheet named 'MENU' or unable to find a table named 't_Data' in this workbook.", , "Error"
Exit Sub
End If
vProject = wsInput.Range(sProjectCell).Value
vQuarter = wsInput.Range(sQuarterCell).Value
If Len(vProject) = 0 Then
wsInput.Select
wsInput.Range(sProjectCell).Select
MsgBox "Input for Project is required.", , "Error"
Exit Sub
ElseIf Len(vQuarter) = 0 Then
wsInput.Select
wsInput.Range(sQuarterCell).Select
MsgBox "Input for Quarter is required.", , "Error"
Exit Sub 'No data
End If
bMatch = False
Set rFound = rProjects.Find(vProject, rProjects.Cells(rProjects.Cells.Count), xlValues, xlWhole, , xlNext, False)
If Not rFound Is Nothing Then
sFirst = rFound.Address
Do
If LCase(rQuarters.Worksheet.Cells(rFound.Row, rQuarters.Column).Value) = LCase(vQuarter) Then
bMatch = True
Exit Do
End If
Set rFound = rProjects.FindNext(rFound)
Loop While rFound.Address <> sFirst
If bMatch Then
rFound.EntireRow.Insert
'Row inserted, proceed with what you want to do with the inserted row here
End If
Else
MsgBox "Unable to find matching row for :" & Chr(10) & "Project: " & vProject & Chr(10) & "Quarter: " & vQuarter, , "Error"
End If
End Sub