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

MJ72

Board Regular
Joined
Aug 17, 2021
Messages
64
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
If I have understood it correctly, the code below will do what you want. Be sure to make a copy of your workbook and paste the code in that copy to try.
To make it all happen:
1. With your workbook active press Alt+F11 to open the Visual Basic Editor (VBE).
2. If not visible press Ctrl+R to open the Project Explorer pane.
3. If necessary unfold the Microsoft Excel Objects folder.
4. Right click on ThisWorkbook and click on View Code.
5. Copy and Paste the "ThisWorkbook module" code into the main right hand pane that opens at step 4.
6. In the VBE use the menu to Insert > Module.
7. Copy and Paste the "standard module" code into the main right hand pane that opens at step 6.
8. Close the VBE's window (Alt+F4).
9. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)

Note that you need to change some sheet names in the code of the MJ72 procedure. Use only upper case!
Hope this helps.

This goes in the ThisWorkbook module:
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    MJ72 Target
   
End Sub


This goes in a standard module:
VBA Code:
Public Sub MJ72(ByVal argTarget As Range)

    Const CHOICE As String = "yes"      ' <<< change to suit

    With argTarget
        If .CountLarge = 1 Then
   
            Dim ShtName As String
            ShtName = UCase(.Parent.Name)
               
            Select Case ShtName
            Case "CALL_LOG"
                If Not Application.Intersect(argTarget, .Parent.Columns("N")) Is Nothing Then
                    If .Value = CHOICE Then Call CopyToActivities(argTarget)
                End If
               
            Case "SHEET 3"      ' <<< change sheet name to suit
                If Not Application.Intersect(argTarget, .Parent.Columns("N")) Is Nothing Or _
                   Not Application.Intersect(argTarget, .Parent.Columns("X")) Is Nothing Then
                    If .Value = CHOICE Then Call CopyToActivities(argTarget)
                End If
    
            Case "SHEET 4"      ' <<< change sheet name to suit
                If Not Application.Intersect(argTarget, .Parent.Columns("N")) Is Nothing Or _
                   Not Application.Intersect(argTarget, .Parent.Columns("Y")) Is Nothing Then
                    If .Value = CHOICE Then Call CopyToActivities(argTarget)
                End If
            End Select
        End If
    End With
End Sub

Private Sub CopyToActivities(ByVal argTarget As Range)
    Dim DestSht As Worksheet
    Set DestSht = argTarget.Parent.Parent.Worksheets("Activities")
    With DestSht
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        .Visible = xlSheetHidden
        argTarget.Parent.Cells(argTarget.Row, "A").Copy .Range("N" & .Cells(.Rows.Count, "N").End(xlUp).Row + 1)
        argTarget.Parent.Cells(argTarget.Row, "C").Copy .Range("O" & .Cells(.Rows.Count, "O").End(xlUp).Row + 1)
        argTarget.Parent.Cells(argTarget.Row, "H").Copy .Range("L" & .Cells(.Rows.Count, "L").End(xlUp).Row + 1)
        .Visible = xlSheetVisible
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End With
End Sub
 
Upvote 0
If I have understood it correctly, the code below will do what you want. Be sure to make a copy of your workbook and paste the code in that copy to try.
To make it all happen:
1. With your workbook active press Alt+F11 to open the Visual Basic Editor (VBE).
2. If not visible press Ctrl+R to open the Project Explorer pane.
3. If necessary unfold the Microsoft Excel Objects folder.
4. Right click on ThisWorkbook and click on View Code.
5. Copy and Paste the "ThisWorkbook module" code into the main right hand pane that opens at step 4.
6. In the VBE use the menu to Insert > Module.
7. Copy and Paste the "standard module" code into the main right hand pane that opens at step 6.
8. Close the VBE's window (Alt+F4).
9. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)

Note that you need to change some sheet names in the code of the MJ72 procedure. Use only upper case!
Hope this helps.

This goes in the ThisWorkbook module:
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    MJ72 Target
  
End Sub


This goes in a standard module:
VBA Code:
Public Sub MJ72(ByVal argTarget As Range)

    Const CHOICE As String = "yes"      ' <<< change to suit

    With argTarget
        If .CountLarge = 1 Then
  
            Dim ShtName As String
            ShtName = UCase(.Parent.Name)
              
            Select Case ShtName
            Case "CALL_LOG"
                If Not Application.Intersect(argTarget, .Parent.Columns("N")) Is Nothing Then
                    If .Value = CHOICE Then Call CopyToActivities(argTarget)
                End If
              
            Case "SHEET 3"      ' <<< change sheet name to suit
                If Not Application.Intersect(argTarget, .Parent.Columns("N")) Is Nothing Or _
                   Not Application.Intersect(argTarget, .Parent.Columns("X")) Is Nothing Then
                    If .Value = CHOICE Then Call CopyToActivities(argTarget)
                End If
   
            Case "SHEET 4"      ' <<< change sheet name to suit
                If Not Application.Intersect(argTarget, .Parent.Columns("N")) Is Nothing Or _
                   Not Application.Intersect(argTarget, .Parent.Columns("Y")) Is Nothing Then
                    If .Value = CHOICE Then Call CopyToActivities(argTarget)
                End If
            End Select
        End If
    End With
End Sub

Private Sub CopyToActivities(ByVal argTarget As Range)
    Dim DestSht As Worksheet
    Set DestSht = argTarget.Parent.Parent.Worksheets("Activities")
    With DestSht
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        .Visible = xlSheetHidden
        argTarget.Parent.Cells(argTarget.Row, "A").Copy .Range("N" & .Cells(.Rows.Count, "N").End(xlUp).Row + 1)
        argTarget.Parent.Cells(argTarget.Row, "C").Copy .Range("O" & .Cells(.Rows.Count, "O").End(xlUp).Row + 1)
        argTarget.Parent.Cells(argTarget.Row, "H").Copy .Range("L" & .Cells(.Rows.Count, "L").End(xlUp).Row + 1)
        .Visible = xlSheetVisible
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End With
End Sub
Good Morning GWteB, I apologize for the delayed reply, I have been unable to work on this task for awhile, since last we chatted actually. Thank you very much for your help, however, I feel like I've misunderstood where to put your code to have this work. I guess I'm just not totally understanding your instructions, copmpletly my fault. :(
May I send you the test workbook so you can see what I've screwed up?
 
Upvote 0
I feel like I've misunderstood where to put your code to have this work.
Okay, below again the previously given instructions, now supported with the accompanying screenshots. See if this helps.

Note that code posted to this forum using code tags appears in a separate code window.
At the top right of this code window there is a copy button to easily copy the code to the clipboard in one operation, see 1st image below.

ScreenShot009.jpg





1. With your workbook active press Alt+F11 to open the Visual Basic Editor (VBE).

ScreenShot001.jpg


2. If not visible press Ctrl+R to open the Project Explorer pane.

ScreenShot004.jpg


3. If necessary unfold the Microsoft Excel Objects folder.
4. Right click on ThisWorkbook and click on View Code.
5. Copy and Paste the "ThisWorkbook module" code into the main right hand pane that opens at step 4.


ScreenShot005.jpg



6. In the VBE use the menu to Insert > Module.

ScreenShot006.jpg


ScreenShot007.jpg


7. Copy and Paste the "standard module" code into the main right hand pane that opens at step 6.


ScreenShot008.jpg


8. Close the VBE's window (Alt+F4).
9. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)
 
Upvote 0
Hey GWTeB, I scrapped everything and restarted, just in case I had done something wrong initially. I have since rebuilt my 4 pages in my test workbook and entered the VBA as you directed. The text transfers perfectly from Call Log to Activities when "yes" is selected in the appropriate column, but does not populate to Follow-Ups when the follow up selection is made, nor does Follow-Ups populate Activities or Archives when the correct selections are made. I tried to recreate what you did to try and figure it out myself to no avail. Any thoughts?
 
Upvote 0
I built the code based on the information you provided in your post #1.
The following could be established from that:
- there's a Sheet 1 called Call_Log
- there's a Sheet 5 called Activities
- there's a Sheet 4 (with no given name)
Furthermore, you refer to the individual modules of Sheets 1, 3 and 4.
So it's not entirely clear whether there are a total of four or five worksheets.

However, it's totally clear that there's at least one source worksheet (Call_Log) and that certain data from that sheet needed to be copied to the worksheet with the name Activities and that (quote) "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)."

In the code I added some comments to point out that you were supposed to change the fictitious names of the source worksheets (Sheet 3 & Sheet 4 used by me) to the actual worksheet names (used by you but unknown to me). If you didn't change those names then the worksheets you want copied to will be ignored and nothing will be copied to them.

It seems that these two lines in the code I provided ...
VBA Code:
            Case "SHEET 3"      ' <<< change sheet name to suit
            ' 
            '
            Case "SHEET 4"      ' <<< change sheet name to suit

... should be changed to:
VBA Code:
            Case "ARCHIVES"      ' << use upper case
            ' 
            '
            Case "FOLLOW-UPS"    ' << use upper case

Hope this helps.
 
Upvote 0
I built the code based on the information you provided in your post #1.
The following could be established from that:
- there's a Sheet 1 called Call_Log
- there's a Sheet 5 called Activities
- there's a Sheet 4 (with no given name)
Furthermore, you refer to the individual modules of Sheets 1, 3 and 4.
So it's not entirely clear whether there are a total of four or five worksheets.

However, it's totally clear that there's at least one source worksheet (Call_Log) and that certain data from that sheet needed to be copied to the worksheet with the name Activities and that (quote) "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)."

In the code I added some comments to point out that you were supposed to change the fictitious names of the source worksheets (Sheet 3 & Sheet 4 used by me) to the actual worksheet names (used by you but unknown to me). If you didn't change those names then the worksheets you want copied to will be ignored and nothing will be copied to them.

It seems that these two lines in the code I provided ...
VBA Code:
            Case "SHEET 3"      ' <<< change sheet name to suit
            '
            '
            Case "SHEET 4"      ' <<< change sheet name to suit

... should be changed to:
VBA Code:
            Case "ARCHIVES"      ' << use upper case
            '
            '
            Case "FOLLOW-UPS"    ' << use upper case

Hope this helps.
I did try those changes before responding to you. And "Yes" is actually "oui", the only reason I omitted the names from the first message was I thought it'd be easier to deal with just "Sheet2", "Sheet3" etc... I was actually trying to make things less complicated, as the sheet names and choice selections are in French. lol. Would seeing screen shots of each page help? I could just email you the test book if that would work more efficiently? Just to clarify as I may have mislead you or not explained fully at first: A to M in "Call Log" needs to populate in "Follow_Ups" when O="oui" and H, A and C needs to copy to L, N and O in "Présences Aux Activitée" when N="oui"; A to M in "Follow_Ups" needs to populate in "Archives" when W="oui" and H, A and C in "Présences Aux Activitée" when either N or X = "oui"; and H, A and C in "Archives" needs to populate in "Présences Aux Activitées" when N or Y = "oui". I've included screen shots to hopefully help. Thank you again for your time and patience.
Call_Log.png
Follow_Ups.png
Archives.png
Présence Aux Activitée.png
 
Upvote 0
I could just email you the test book if that would work more efficiently?
A sample file would be nice. Please include samples of both source sheets and target sheets, the latter twice: a copy before the code has run and a copy how it's supposed to become after the code has run.
Upload your workbook to a public facility on the net, like DropBox, Google Drive or WeTransfer and post the link to that file in this thread. Make sure the file is not kept private but marked for sharing.
 
Upvote 0
A sample file would be nice. Please include samples of both source sheets and target sheets, the latter twice: a copy before the code has run and a copy how it's supposed to become after the code has run.
Upload your workbook to a public facility on the net, like DropBox, Google Drive or WeTransfer and post the link to that file in this thread. Make sure the file is not kept private but marked for sharing.
Let me know if this works. I took out all VBA and Macros as to not have any confusion. Test Book 1 is ready to be edited and Test Book 2 is identical except for notes I've made on each sheet to better explain what I'm trying to do.



Thanks Again!
 
Upvote 0
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:
VBA Code:
Option Explicit

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

    MJ72 Target

End Sub


This goes in a standard module:
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,913
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top