Why won't code copy data from worksheet to applicable table.


Question:    The code that Variatus wrote is working up to the point where it gives the err message block for each of the worksheet tabs, but I still need assistance  on getting the data copied to the appropriate tables (24 of them) that are located in the MONTHLY GOE RECONCILIATION worksheet (Attached).

For the worksheets 21000, 21010, 21020, 21030, 21036, 21070 and 21090 listed on the Sheetlists, column "K" (11) is where the "NO" is selected, that will then trigger the copying of data from columns B, D, and J on the row where "NO" was selected and paste that data into the appropriate table by same name and put the data into columns B, C and D on first available row.

For all the other worksheets listed in the Sheetlist, Column "I" (9) is where the "NO" is selected from the dropdown list that will cause the data from columns A, B and G to be copied into the appropriate table in the MONTHLY GOE RECONCILIATION worksheet (attached) under columns B, C and D on first available row.

One thought is I need to modify the sheetlist that has dropdown list in column "K" and then insert another set of code for those sheetlist items with dropdown in column G.  Then modify the CopyToTable portion of code for the SheetList items where the dropdown is located in column "K".  Just a possible idea but not sure.

I appreciate any help to get this code to work, as it is the final phase of this project.

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 Conference Room Rental,23370 Telephone Services,24090 Printing and Reproduction,"
        SheetList = SheetList & "24120 Subscriptions Periodicals,25103 Professional Fees,25108 Registration Fees,25209 Room Rental Retreat Svcs,"
        SheetList = SheetList & "25215 Other Goods & Services,25338 Fingerprints,25626 Wellness,25713 Copiers Recurring Costs,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
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"
        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



You have posted only one sheet, in XLSX format (meaning no code). Therefore I can understand only a small portion of your question (which I don't regret, lol:).

The problem is that your table names aren't identical with tab names. Table names contain underscores which aren't (all) present in the tab names, or so I presume since I don't have an example. I recommend that you avoid the possibility of such errors by storing your names in a single location and then call them up by number. The enum below numbers them, from 0 up. Observe that enums must be in a standard code module, at the top of the sheet, before any procedures. They are available throughout the code project, in all modules and procedures.

Enum Nid                        ' Sheet & Table IDs
                                ' first Nid = 0, each following incremented by 1
    ' 15 Dec 2017
    NidState                    ' 21000 State Program Travel
    NidMisc                     ' 21010Miscellaneous Travel
    NidPresent                  ' 21020 Presentation Travel
    NidConfer                   ' 21030 Conference Travel
    NidTrain                    ' 21036 Training Travel
    NidShare                    ' 21070 Shared or Remote Travel
    NidRetreat                  ' 21090 Division Retreat Travel
    NidGov                      ' 21071 GOV Related Costs
    NidRent                     ' 23230 Conference Room Rental
    NidTel                      ' 23370 Telephone Services
    NidPrint                    ' 24090 Printing and Reproduction
    NidSuscribe                 ' 24120 Subscriptions Periodicals
    NidProFees                  ' 25103 Professional Fees
    NidRegFees                  ' 25108 Registration Fees
    NidRooms                    ' 25209 Room Rental Retreat Svcs
    NidOther                    ' 25215 Other Goods and Services
    NidFingers                  ' 25338 Fingerprints
    NidWellness                 ' 25626 Wellness
    NidCopy                     ' 25713 Copiers Recurring Costs
    NidSupply                   ' 26062 Supplies
    NidSafety                   ' 26069 Safety Equipment
    NidEquip                    ' 31050 Equipment ADP NONCAP
    NidOffice                   ' 31110 Office Equipment
    NidSoft                     ' 31300 Software
    Nid61                       ' 99999 Table61: Probably a table you overlooked
    NidCount                    ' total number of names
End Enum

In order to be able to utilise the advantage of numbered names you need a function which converts the number to name, like this one.

Function TabName(Tid As Nid, _
                 Optional AsTblName As Boolean) As String
    ' 15 Dec 2017
    Dim Fun As String
    Dim Nm(NidCount - 1) As String
    Nm(NidState) = "21000 State Program Travel"
    Nm(NidMisc) = "21010 Miscellaneous Travel"
    Nm(NidPresent) = "21020 Presentation Travel"
    Nm(NidConfer) = "21030 Conference Travel"
    Nm(NidTrain) = "21036 Training Travel"
    Nm(NidShare) = "21070 Shared or Remote Travel"
    Nm(NidRetreat) = "21090 Division Retreat Travel"
    Nm(NidGov) = "21071 GOV Related Costs"
    Nm(NidRent) = "23230 Conference Room Rental"
    Nm(NidTel) = "23370 Telephone Services"
    Nm(NidPrint) = "24090 Printing and Reproduction"
    Nm(NidSuscribe) = "24120 Subscriptions Periodicals"
    Nm(NidProFees) = "25103 Professional Fees"
    Nm(NidRegFees) = "25108 Registration Fees"
    Nm(NidRooms) = "25209 Room Rental Retreat Svcs"
    Nm(NidOther) = "25215 Other Goods and Services"
    Nm(NidFingers) = "25338 Fingerprints"
    Nm(NidWellness) = "25626 Wellness"
    Nm(NidCopy) = "25713 Copiers Recurring Costs"
    Nm(NidSupply) = "26062 Supplies"
    Nm(NidSafety) = "26069 Safety Equipment"
    Nm(NidEquip) = "31050 Equipment ADP NONCAP"
    Nm(NidOffice) = "31110 Office Equipment"
    Nm(NidSoft) = "31300 Software"
    Nm(Nid61) = "99999 Table61: Probably a table you overlooked"
    Fun = Nm(Tid)
    If AsTblName Then Fun = Replace(Fun, " ", "_")
    TabName = Fun
End Function

You can call this function with code like this.

Private Sub TestNid()
    MsgBox TabName(NidOffice)
End Sub
Since NidOffice has the value of 22 (analog to Long, BTW),  MsgBox TabName(22) would produce an identical result.

The function has an optional second parameter. Try MsgBox TabName(NidOffice, True) to return a string fit for use in table names.

The procedure below will print the names of all sheets to the Immediate window.

Private Sub LoopTest()
    Dim i As Long
    For i = 0 To NidCount - 1           ' Count is 1-based, array is 0-based
        Debug.Print TabName(i)        ' or TabName(i, True)
    Next i
End Sub
Basically, this is code which can replace the 'SheetList' variable in your 'TestLoop' procedure, either by calling the sheets one by one (without the need to verify if they are in the list) or by creating the list if you so prefer. The point is that you can have the tab name or table name with a single number.

Of course, you would have to make sure that your tabs and tables are really named as declared. In order to do so, I would use the Enum to assign generic names to the tables, like "Tbl22" (concatenated from the enumeration), or simply "22". I would follow the same system to assign CodeNames to my sheets and then refer to them by CodeName. The CodeName is the "(Name)" property accessible from VBE. The "Name" property is accessible from the worksheet. If you refer to the sheets by their CodeName it doesn't matter what the tab names are. Of course, if you follow this advice you wouldn't need the TabName function, unless you want to make sure that labels in your master sheet have the correct captions.

If you implement such control, or solve the problem in a way that appears less laborious, you will still have the face the fact, as I recall, that my earlier code looks for the tables in the worksheets by the "same" name. Of course, the tables are all in the master sheet. I hope you will be able to find the place and redirect the code's effort.



Hi and thanks for getting back to me.  I will open a new question so I can post one sample worksheet and the MONTHLY GOE RECONCILIATION worksheet with the tables on it in xlsm format so you can see all that I have done and what I am trying to do. 
CaptainRetired (rep: 2) Dec 15, '17 at 4:46 pm
Please remember the Q & A nature of this forum. If your question hasn't been answered to your satisfaction, or if you feel that a casual visitor following our conversation may not benefit from the answer, please shine your torch on the weak points so that they can be filled out. When everything is done as it should be please accept the answer to show that the thread was closed successfully.
Variatus (rep: 813) Dec 15, '17 at 9:29 pm
Add to Discussion

Answer the Question

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