VBA help needed to autopopulate a table based on a dropdown list value on another sheet

[MJ72]

I'm working with multiple sheets, 3 of which have cells where a "yes" or "no" answer can be entered via a dropdown list. I have another sheet that has an unformatted table that I need filled with some of the information from the rows on the other 3 sheets providing that a "yes" is chosen in the appropriate dropdown.

To explain further: I have one sheet (Sheet 1) called "Call_Log" and in column (N) I have a dropdown that allows for either a yes or no answer. Should "yes" be chosen in (for example) (N,2) I need the information (just the values) from (A,2), (C,2) and (H,2) of the same sheet to then be copied and pasted to the next available row in columns (N), (O) and (L) respectively on (Sheet 5) entitled "Activities". [ A copy to N, C to O and H to L - just to clarify]

This same process needs to happen from a "yes" response in columns (N) and (X) on (Sheet 3) and in columns (N) and (Y) on (Sheet 4).

I plead to the experts on this forum for help. I know it likely requires VBA in the individual sheet modules for Sheets 1, 3 and 4 because VLOOKUP doesn't help with auto-populating the next available row on Sheet 5 but I don't have the knowledge to write the code.

Thanks and praise to anyone that can help.

MJ

 

[MJ72]

Hi Mike, I suspect that the main cause of the code only partially working was a case sensitivity issue. I had already taken this into account with the worksheet names, but not with the yes/no user choice. Another cause of unwanted effects appeared to be the use of tables. On some worksheets you used a table, on some others you didn't.

I've provided all worksheets to which data is copied (depending on the user's choice) with a table. The workbook is then consistent in that respect and the VBA code can remain relatively simple.
As you've probably noticed, a table is a dynamic range with a name. You can change that name and of course I have done that for all existing and newly added tables. When you open the name manager (ribbon > Formulas tab) you get an overview of all names within the current workbook and the ranges (or formulas; not used in your workbook) they refer to.

There's now an additional worksheet. This worksheet contains a number of small tables, which are used for the data validation drop downs (DVdd). Above each table is a cell provided with such a DVdd as an example. I've not created a DVdd for all columns where DV is desired. I leave this to you. A link to a video on YouTube regarding the approach I used (as there are more ways to skin a cat) is attached.

About the tables used for your data, my code assumes that each table contains at least one row of (dummy) data, of which the individual cells may have a certain (custom) format and are provided with a DVdd where desired. The moment a data row needs to be copied (partially) from one table to another, the target table is provided with a new empty row first. Excel automatically copies the formatting and any existing DVdd to the new empty line from above, so we (or the code that adds the new row) do not need to do anything further with that regard, solely copy data as required to the newly added row.

You can delete the dummy data afterwards: right click on a random cell in the row to be deleted, choose Delete > Table Rows. The advantage is that not an entire worksheet row is deleted so data on both left hand and right hand side of the table stays untouched.

No doubt it is technically possible to create an Outlook Task automatically depending on certain conditions, but I will politely ignore your additional request in this regard.

Example Workbook (DropBox)

This goes in the ThisWorkbook module:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    MJ72 Target

End Sub

This goes in a standard module:

Option Explicit

Public Sub MJ72(ByVal argTarget As Range)

    Const CHOICE As String = "OUI"      ' <<< choice needs to be coded in uppercase

    If argTarget.CountLarge = 1 Then
 
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual

        With argTarget.Parent

            Select Case UCase(.Name)

            Case "CALL_LOG"             ' <<< Sheet name needs to be coded in uppercase

                ' check on column L > Nouvel employeur?
                If Not Application.Intersect(argTarget, .Columns("L")) Is Nothing Then
                    If UCase(argTarget.Value) = CHOICE Then
                        CopyFromCallLogToDataBase argTarget
                    End If

                ' check on column N > Devrait-on faire une présence aux activités ?
                ElseIf Not Application.Intersect(argTarget, .Columns("N")) Is Nothing Then
                    If UCase(argTarget.Value) = CHOICE Then
                        CopyFromCallLogToPrécenceAuxActivitée argTarget
                    End If

                ' check on column O > Planifierez-vous un suivi ?
                ElseIf Not Application.Intersect(argTarget, .Columns("O")) Is Nothing Then
                    If UCase(argTarget.Value) = CHOICE Then
                        CopyFromCallLogToFollowUps argTarget
                    End If
                End If


            Case "FOLLOW_UPS"

                ' check on column V > Archive
                If Not Application.Intersect(argTarget, .Columns("V")) Is Nothing Then
                    If UCase(argTarget.Value) = CHOICE Then
                        CopyFromFollowUpsToArchives argTarget
                    End If
                ' check on column W > Nouvelles Présences aux Activités à faire ?
                ElseIf Not Application.Intersect(argTarget, .Columns("W")) Is Nothing Then
                    If UCase(argTarget.Value) = CHOICE Then
                        CopyFromFollowUpsToPrecences argTarget
                    End If
                End If


            Case "ARCHIVES"

                ' check on column X > Nouveau Présences aux activités à compléter ?
                If Not Application.Intersect(argTarget, .Columns("X")) Is Nothing Then
                    If UCase(argTarget.Value) = CHOICE Then
                        CopyFromArchivesToPrecences argTarget
                    End If
                End If
            End Select
        End With

        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True

    End If
End Sub


Private Sub CopyFromCallLogToDataBase(ByVal argTarget As Range)

    ' add a new row to the given table & obtain a reference to that newly added table row
    Dim lr As ListRow
    Set lr = Range("ShtTblDataBase").ListObject.ListRows.Add

    With argTarget.Parent
        '                |
        ' column number \|/ within newly added table row of the referenced table
        '                |
        lr.Range.Cells(, 1).Value = .Cells(argTarget.Row, "A").Value
        lr.Range.Cells(, 2).Value = .Cells(argTarget.Row, "H").Value
        lr.Range.Cells(, 6).Value = .Cells(argTarget.Row, "C").Value
        lr.Range.Cells(, 8).Value = .Cells(argTarget.Row, "F").Value
        lr.Range.Cells(, 9).Value = .Cells(argTarget.Row, "D").Value
        lr.Range.Cells(, 12).Value = .Cells(argTarget.Row, "B").Value
    End With
End Sub

Private Sub CopyFromCallLogToPrécenceAuxActivitée(ByVal argTarget As Range)

    Dim lr As ListRow
    Set lr = Range("ShtTblPrésActiv").ListObject.ListRows.Add

    With argTarget.Parent
        lr.Range.Cells(, 1).Value = .Cells(argTarget.Row, "H").Value
        lr.Range.Cells(, 3).Value = .Cells(argTarget.Row, "A").Value
        lr.Range.Cells(, 4).Value = .Cells(argTarget.Row, "C").Value
    End With
End Sub

Private Sub CopyFromCallLogToFollowUps(ByVal argTarget As Range)

    Dim lr As ListRow
    Set lr = Range("ShtTblFollowUps").ListObject.ListRows.Add

    ' copy only first eleven columns across (A:K)
    With argTarget.Parent
        lr.Range.Resize(, 11).Value = .Range(.Cells(argTarget.Row, "A"), .Cells(argTarget.Row, "K")).Value
    End With
End Sub

Private Sub CopyFromFollowUpsToArchives(ByVal argTarget As Range)

    Dim lr As ListRow
    Set lr = Range("ShtTblArchives").ListObject.ListRows.Add

    ' copy only first fourteen columns across (A:N)
    With argTarget.Parent
        lr.Range.Resize(, 14).Value = .Range(.Cells(argTarget.Row, "A"), .Cells(argTarget.Row, "N")).Value
    End With
End Sub

Private Sub CopyFromFollowUpsToPrecences(ByVal argTarget As Range)
    With argTarget.EntireRow
        Dim MaxDate As Long
        MaxDate = MaxOfList(.Range("Q1").Value, _
                            .Range("S1").Value, _
                            .Range("U1").Value)
    End With

    Dim lr As ListRow
    Set lr = Range("ShtTblPrésActiv").ListObject.ListRows.Add

    With argTarget.Parent
        If MaxDate > 0 Then
            lr.Range.Cells(, 1).Value = MaxDate
        End If
        lr.Range.Cells(, 3).Value = .Cells(argTarget.Row, "A").Value
        lr.Range.Cells(, 4).Value = .Cells(argTarget.Row, "C").Value
    End With
End Sub

Private Sub CopyFromArchivesToPrecences(ByVal argTarget As Range)
    With argTarget.EntireRow
        Dim MaxDate As Long
        MaxDate = MaxOfList(.Range("P1").Value, _
                            .Range("R1").Value, _
                            .Range("T1").Value, _
                            .Range("V1").Value)
    End With

    Dim lr As ListRow
    Set lr = Range("ShtTblPrésActiv").ListObject.ListRows.Add

    With argTarget.Parent
        If MaxDate > 0 Then
            lr.Range.Cells(, 1).Value = MaxDate
        End If
        lr.Range.Cells(, 3).Value = .Cells(argTarget.Row, "A").Value
        lr.Range.Cells(, 4).Value = .Cells(argTarget.Row, "C").Value
    End With
End Sub


Public Function MaxOfList(ParamArray argValues() As Variant) As Variant
    Dim i As Long, Max As Variant
    Max = Null
    For i = LBound(argValues) To UBound(argValues)
        If VBA.IsNumeric(argValues(i)) Or VBA.IsDate(argValues(i)) Then
            If Max >= argValues(i) Then
                'do nothing
            Else
                Max = argValues(i)
            End If
        End If
    Next
    MaxOfList = Max
End Function

Thank you very much GWTeB! I haven't had a chance to integrate into my actual project but the test book works great!! Happy Holidays to you and your family and thank you again for your guidance with this.

 

[GWteB]

Glad to help. Thanks for the follow-up and good luck with your project.