Use drop down list to copy select data to another worksheet

0

I am currently working on a workbook I designed for work and am having some trouble trying to come up with a macro that will copy select data from one worksheet that has dropdown list onto another worksheet in same workbook.  Just learning VBA and macros using the internet, but have not been able to find anything relevant.  I would rather use a macro as do not want to risk users deleting formulas, as my dropdown list can be cleared simply by hitting delete.

I have 23 worksheets that have the dropdown in column I, beginning with row 6.  The dropdown list is "Yes" and "No".  I only want to copy and transfer data from columns A, B and G on each worksheet for the row where "No" is selected to a respective table (23 tables, one for each worksheet, each table named the same as the worksheet from which I want to copy data from) in columns A, B and C. 

This a financial tracking workbook and the page I want to transfer the "No" selections to is a monthly reconciliation set of tables.

Any help would be greatly appreciated! 

Answer
Discuss

Answers

0
Selected Answer

Please paste the code below in a standard code module (by default 'Module1' but you can give it any name). Observe that both subs are 'Private', meaning you can't call them from the worksheet. Depending upon how you wish to initialise the action you may remove the 'Private' from the first sub, but not from the second. It will still work if you do, but it can't work when called from the worksheet. So, why make it available?

Option Explicit
Private Sub TestLoop()
    
    Dim Ws As Worksheet
    Dim SheetList As String
    
    Application.ScreenUpdating = False
    For Each Ws In Worksheets
        ' list all your 23 sheets in this string"
        SheetList = "CaptRet,Capt2,Capt3,Capt4" & _
                    "Ret1,Ret2,Ret3" & _
                    "Some,Other,Sheet's,Name"
        If InStr(1, SheetList, Ws.Name, vbTextCompare) Then
            CopyToTable Ws
        End If
    Next Ws
    Application.ScreenUpdating = True
End Sub
Private Sub CopyToTable(Ws As Worksheet)
    ' 02 Dec 2017
    
    Dim Tbl As ListObject
    Dim NewRow As ListRow
    Dim RowArray As Variant
    Dim Rl As Long
    Dim R As Long, C As Long
    
    On Error Resume Next
    Set Tbl = Ws.ListObjects(Ws.Name)
    If Err Then
        MsgBox "Please set up a table by the name of" & vbCr & _
               """" & Ws.Name & """ and run this macro again.", _
               vbExclamation, "Missing table"
    Else
        Tbl.DataBodyRange.Rows.Delete       ' delete all table content
    End If
    On Error GoTo 0
    ' make sure that your table is NOT in column A
    ' or select another column to determine the last used row in the sheet
    Rl = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row
    For R = 6 To Rl                         ' start looking in row 6
        With Ws.Rows(R)
                                            ' 9 = Column I
            If StrComp(.Cells(9).Value, "no", vbTextCompare) = 0 Then
                                            ' column 7 = G
                RowArray = Range(.Cells(1), .Cells(7)).Value
                ' move value of column 7 to column 3
                RowArray(1, 3) = RowArray(1, 7)
                ' discard columns 4 to 7
                ReDim Preserve RowArray(1 To 1, 1 To 3)
            
                With Tbl
                    Set NewRow = .ListRows.Add
                    .DataBodyRange.Cells(.ListRows.Count, 1).Resize(1, UBound(RowArray, 2)).Value = RowArray
                End With
            End If
        End With
    Next R
End Sub

The first sub loops through all the sheets in your workbook, compares each sheet's name against an "approved" list and ignores those which aren't on the list. Perhaps it's shorter to make a list of the sheets not to process If you make such a list change the line below the list to read "If InStr(1, SheetList, Ws.Name, vbTextCompare) = 0 Then" (adding "= 0").

The rest of the code is pretty straight forward. I have added some comments for you which I hope will help you understand the logic. I felt, however, that your method of entering "Yes" and "No" is cumbersome, especially if you are facing co-workers who like to delete things. I have designed code which runs when you double-click on a cell. Each time you double-click the cell value will toggle between "Yes" and "No". The program limits this action to the sells in column I. To try it out, please install the function below in a standard code module. You can add it to the other code. Observe that this procedure must be 'Public" which it is by default, if not declared as "Private".

Function DoubleClick(ByVal Target As Range)
    ' 02 Dec 2017
    
    Dim Ws As Worksheet
    Dim Rng As Range
    Dim Rl As Long
    
    DoubleClick = False
    With Target
        Set Target = .Cells(1)
        Set Ws = .Worksheet
    End With
    
    With Ws
        ' make sure that your table is NOT in column A
        ' or select another column to determine the last used row in the sheet
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(6, "I"), .Cells(Rl, "I"))
    End With
    
    If Not Application.Intersect(Target, Rng) Is Nothing Then
        With Target
            .Value = Array("No", "Yes")(Abs(Sgn(StrComp(.Value, "Yes", vbTextCompare))))
        End With
        DoubleClick = True
    End If
End Function

This function responds to an event procedure. Event procedures are 'Private' to each worksheet. They must be installed in the code sheet of the worksheet on which you want to have the action. It is very short code, but you must install it on each of your 23 sheets.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = DoubleClick(Target)
End Sub
Discuss

Discussion

[CODE]Code_Goes_Here I keep getting syntax error on this code. I entered each of the worksheet names as defined in the Design tab under table name. (Or do I name each sheet what is listed on the tabs at the bottom of each worksheet?). The various tables upon which I want data copied to are named by the object class and formal name. Not sure what to do, but I GREATLY APPRECIATE YOUR WILLINGNESS TO HELP ME OUT! I am learning and am trying my best to understand everything, just may take a while to fully comprehend what to do. I can not seem to enter code in this block to show you what I have done.  Any help appreciated!
CaptainRetired (rep: 2) Dec 4, '17 at 11:55 am
I keep getting syntax error on this code. I entered each of the worksheet names as defined in the Design tab under table name. (Or do I name each sheet what is listed on the tabs at the bottom of each worksheet?). The various tables upon which I want data copied to are named by the object class and formal name. Not sure what to do, but I GREATLY APPRECIATE YOUR WILLINGNESS TO HELP ME OUT!   The worksheet that contains all the tables that I want to copy the data to start with column A and end with F (This is in response to your comment).  I am learning and am trying my best to understand everything, just may take a while to fully comprehend what to do.  I am also not able to insert the code into the code tag as it states it is too long. (Suggestions to get it posted so you can review it would be helpful).  
CaptainRetired (rep: 2) Dec 4, '17 at 12:08 pm
OK. The first taks is to get the 'TestLoop' procedure going. The 'SheetList' string should contain the sheet names as they are written on the worksheet tabs. If you are looking at the sheet properties, it is the "Name" property, not the "(Name)" property.
Next, if you still get any kind of error please make sure to indicate when, where and/or how it occurs. Normally, an error message will pop up giving an error number and description and offering a 'Debug' button. Note the number and description, then press the button. The window will switch to VBA and the offending line of code will be highlighted.
Variatus (rep: 1715) Dec 4, '17 at 7:57 pm
Sorry - Been out of state for work and have not had time to get back to you.
Here is the first portion of the code that gave a Compile Error  Syntax Error with a orange-yellow triangle, no error number.  Private Sub TestLoop() was highlighted in yellow. The Sheetlist with names of worksheet tabs and the If InStr lines are in red. Once I click on the OK button, the Sheetlist and If InStr lines are highlighted in blue.(The entire code is too long to insert into the post).  The Sheetlist names are the exact names listed on the tabs at the bottom of each worksheet and they correspond to the table names on another worksheet.  Thanks for all your help.

Private Sub TestLoop()
    
    Dim Ws As Worksheet
    Dim SheetList As String
    
    Application.ScreenUpdating = False
    For Each Ws In Worksheets
        ' list all your 23 sheets in this string"
        SheetList = "21000 State Program Travel,21010 Miscellaneous Travel,21020 Presentation Travel,21030 Conference Travel,21036 Training Travel,21070 Shared or Remote Travel" & _
                    "21090 Division Retreat Travel,21071 GOV-Related Costs,23230 Room Rental (Conferences),23370 Telephone Services,24090 Printing & Reproduction,24120 Subscriptions-Periodicals" & _
                    "25103 Professional Fees,25108 Registration Fees,25209 Retreat Svcs-Room Rental,25215 Other Goods & Services,25338 Fingerprints,25626 Wellness,25713 Copiers-Recurring Costs" & _
                    "26062 Supplies,26069 Safety Equipment,31050 Equipment-ADP-NONCAP,31110 Office Equipment,31300 Software" _
        If InStr(1, SheetList, Ws.Name, vbTextCompare) Then
            CopyToTable Ws
        End If
    Next Ws
    Application.ScreenUpdating = True
End Sub
CaptainRetired (rep: 2) Dec 12, '17 at 4:15 pm
Haha, I tried to anticipate that. Modify the syntax of your SheetList. VBA will alert you to that error even while you write the list into code. When you finish writing the specs click elsewhere. If the syntax is wrong VBA will take you back to the error.
A string is entered between quotation marks, like "Sheet1,Sheet2". You can list all your sheets in one line like that. If you find the line is too long and you wish to break it, you can do so by concatenating strings, like "Sheet1,Sheet2," _
"Sheet3,Sheet4"
Space, folowed by an underscore, breaks the line. Observe the final comma after "Sheet2". It is needed when the strings are joined.
Variatus (rep: 1715) Dec 12, '17 at 9:34 pm
However, you may also encounter another problem which I didn't think of earlier. The maximum number of characters in a concatenation using space/underscore is 255. So, if you have correctly concatenated all 23 sheet names as described above you may still get a syntax error because of the excessive length, and that one won't even show while you are typing code. The answer is to use another way of concatenation.
SheetList = "Sheet1,Sheet2," _
                   "Sheet3,Sheet4,"
SheetList = SheetList & "Sheet5,Sheet6," _
                                      "Sheet7,Sheet8"
The length of the first 'SheetList' is unlimited and then prefixed to the next concatenation of max 255 characters to jointly have an unlimited length. If necessary, you can repeat this several times. However, as I already said earlier, if the number of sheets in your workbook is static you might prefer to list the sheets which should NOT be processed and modify the following code accordingly.
Variatus (rep: 1715) Dec 12, '17 at 9:34 pm
Ok - I redid SheetList and have no errors (Only included the TestLoop code as otherwise too long).  Now when run it gives the following message: " Please set up a table by the name of 21000 State Program Travel and run this macro again."  Same message for each worksheet listed in SheetList.    I already have built a table for each worksheet to transfer the data (they are combined on one worksheet called MONTHLY GOE RECONCILIATION.  Not sure what to do next.  Code is on next Discussion Field as says too long for this one
CaptainRetired (rep: 2) Dec 13, '17 at 9:17 am
Option Explicit
Private Sub TestLoop()
    
    Dim Ws As Worksheet
    Dim SheetList As String
    
    Application.ScreenUpdating = False
    For Each Ws In Worksheets
        ' list all your 23 sheets in this string"
        SheetList = "21000 State Program Travel,21010 Miscellaneous Travel,21020 Presentation Travel,21030 Conference Travel,21036 Training Travel,21070 Shared or Remote Travel,"
                    
        SheetList = SheetList & "21090 Division Retreat Travel,21071 GOV-Related Costs,23230 Room Rental (Conferences),23370 Telephone Services,24090 Printing & Reproduction,"
        
        SheetList = SheetList & "24120 Subscriptions-Periodicals,25103 Professional Fees,25108 Registration Fees,25209 Retreat Svcs-Room Rental,"
                    
        SheetList = SheetList & "25215 Other Goods & Services,25338 Fingerprints,25626 Wellness,25713 Copiers-Recurring,26062 Supplies,26069 Safety Equipment,"
        
        SheetList = SheetList & "31050 Equipment-ADP-NONCAP,31110 Office Equipment,31300 Software"
                    
        If InStr(1, SheetList, Ws.Name, vbTextCompare) Then
            CopyToTable Ws
        End If
    Next Ws
    Application.ScreenUpdating = True
End Sub
CaptainRetired (rep: 2) Dec 13, '17 at 9:18 am
I also went into the worksheet MONTHLY GOE RECONCILIATION and for each table I checked under Design the Table name to ensure it was the same as that written on the SheetList, using underscore for spaces (example:  _21000_State_Program_Travel).  Not sure what to check next.  Thanks again
CaptainRetired (rep: 2) Dec 13, '17 at 9:49 am
I had to make some changes in some of the worksheets to comply with directives.  This applies for the following worksheets:  21000 State Program Travel, 21010 Miscellaneous Travel, 21020 Presentation Travel, 21030 Conference Travel, 21036 Training Travel, 21070 Shared or Remote Travel and 21090 Division Retreat Travel.  On these worksheets, when I select "NO" from COLUMN K (#11), I need data from columns B, D and H for each particular row where "NO" is selected to transfer to that appropriate table on the MONTHLY GOE RECONCILIATION worksheet in Columns B, C, and D on a new row.  (I have built the tables with 100 lines, I want data as selected from the worksheets to go to the first available row on the table, if that makes sense).  The other worksheets are using Column I (#9) for the "No" selection as previously mentioned.  Their data will also go to the appropriate table on next available row in table.  NOTE:  These 24 Tables are built on the one worksheet named MONTHLY GOE RECONCILIATION.  The first table's (21000 State Program Travel) first blank row is 4.  The second table's (21010 Miscellaneous Travel) first blank row is 107.  I am not sure how to to build this into the code.  If this is information we need, I can send you the first available row for each table.

Thanks so much for all you are doing to help me out!  Everything you are doing is helping me learn!
CaptainRetired (rep: 2) Dec 13, '17 at 3:42 pm
This is getting clearly out of hand. This is a Q & A forum. Please help me stay within the confines of what that implies.
First, you asked for some code, received it, and we made it work. Therefore this question should now be answered. I suggest you accept the answer and move on.
Second, In your question you stated that each worksheet had a table in it by the same name as the worksheet. Now the code can't find these tables. Obviously, the discussion fields under the current thread impose too many constraints to formulate or answer the implied question. I suggest you ask a new question, something like "why can't my code find the table in this worksheet". Logically, you would attach both the worksheet and the code which would give a fair chance to me to find the reason.
Variatus (rep: 1715) Dec 13, '17 at 8:38 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login