I have been getting help from Variatus (thanks much!) but I am stuck on trying to use Enum to name tables and CodeName for each worksheet. My last post, I failed to post the xlsm document, so unable to view anything. I have so many macros in this project that not sure if I can change the table names on the worksheets(where the select data is copied from after selecting the dropdown choice of "NO" and the master table worksheet (where select data goes after selecting dropdown choice of "NO") without messing up what I have already got working on my own.
This should not be hard but I am sure struggling with nomenclature, process etc. I have posted two previous questions that Variatus has helped me with to get to this point, but now I made sure I put on forms in xlsm so you can see what I am trying to accomplish. This is the last part of my work project to fully implement.
Thanks again for any help.
Enum Nid ' Sheet & Table IDs
' first Nid = 0, each following incremented by 1
' 15 Dec 2017
NidState ' 21000 State Program Travel
NidMisc ' 21010 Miscellaneous 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
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
Private Sub TestNid()
MsgBox TabName(NidOffice, True)
End Sub
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
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