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

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