Userform data to populate specific tables on worksheet - excel

Question

I have been searching high and low and have come up with some results but not what I'm trying to accomplish.
I have two different userforms, one to create a Purchase Order, another to create a Change Order. Depending on the userform that is selected, once data is entered and the command button is used, I need the data to populate either Table1 (for Purchase Orders from the POUserform) or Table2 (for Change Orders from the COUserform). Both tables are on the same worksheet. Is this even possible???
Below is the code I currently have - it always wants to populate the same Table no matter what userform I am running.
Note that the code for Userform 1 and Userform 2 are exactly the same with the exception of "Table1" and "Table 2".
Private Sub SendCOButton_Click()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim rng As Range
Set rng = ActiveSheet.ListObjects("Table2").Range
Dim LastRow As Long
Dim iRow As Long
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Set WS1 = Worksheets("Original Contracts")
Set WS2 = Worksheets("Purchase Order Template")
Set WS3 = Worksheets("Project Snapshot")
'find first empty row in database
iRow = WS1.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
LastRow = WS3.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
If WorksheetFunction.CountIf(WS3.Range("A1:A5000", WS3.Cells(LastRow, 1)),
Me.CONo.Value) > 0 Then
MsgBox "Duplicate Change Order Number!", vbCritical
Exit Sub
End If
'copy the data to the database
'use protect and unprotect lines,
' with your password
' if worksheet is protected
With WS1
End With
With WS2
.Range("H1").Value = Me.CONo.Value
.Range("B6").Value = Me.COTradeList.Value
.Range("H6").Value = Me.COAttn.Value
.Range("B7").Value = Me.COEmail.Value
.Range("H7").Value = Me.COPhone.Value
.Range("H16").Value = Me.COPrice1.Value
End With
With WS3
rng.Parent.Cells(LastRow, 1).Value = CONo.Value
rng.Parent.Cells(LastRow, 2).Value = COTradeList.Value
rng.Parent.Cells(LastRow, 3).Value = COItems.Value
rng.Parent.Cells(LastRow, 4).Value = CODescription1.Value
rng.Parent.Cells(LastRow, 5).Value = COPrice1.Value
rng.Parent.Cells(LastRow, 6).Value = CODateIssued.Value
End With
Set xSht = Worksheets("Purchase Order Template")
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFileDlg.Show = True Then
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "You must specify a folder to save the PDF into." & vbCrLf &
vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify
Destination Folder"
Exit Sub
End If
xFolder = xFolder + "\" & Worksheets("Purchase Order
Template").Range("B9").Value & " - PO No. " & Worksheets("Purchase Order
Template").Range("G1").Value & " - " & Worksheets("Purchase Order
Template").Range("B6").Value & ".pdf"
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do
you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox "if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.",
vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is
not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.",
vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder,
Quality:=xlQualityStandard
'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
Set xSht = Worksheets("Purchase Order Template")
With xEmailObj
.Display
.To = Worksheets("Purchase Order Template").Range("B7").Value
.CC = ""
.BCC = ""
.Subject = Worksheets("Purchase Order Template").Range("E9").Value & "
- " & "PO# " & Worksheets("Purchase Order Template").Range("G1").Value &
" - " & Worksheets("Purchase Order Template").Range("B6").Value
.Attachments.Add xFolder
If DisplayEmail = False Then
'.Send
End If
End With
Else
MsgBox "The active worksheet cannot be blank"
Exit Sub
End If
Unload Me
End Sub

Answer 1

We have NO idea on the layout of your sheets, but we can try to get a picture of what's happening using the code:
This section appears to be the part which (I assume) you change to refer to the appropriate table:
Dim rng As Range
Set rng = ActiveSheet.ListObjects("Table2").Range
You then, later in the code, write to a sheet using:
With WS3
rng.Parent.Cells(LastRow, 1).Value = CONo.Value
rng.Parent.Cells(LastRow, 2).Value = COTradeList.Value
rng.Parent.Cells(LastRow, 3).Value = COItems.Value
rng.Parent.Cells(LastRow, 4).Value = CODescription1.Value
rng.Parent.Cells(LastRow, 5).Value = COPrice1.Value
rng.Parent.Cells(LastRow, 6).Value = CODateIssued.Value
End With
Let's look at what you're doing here by breaking down a couple of the lines:
Firstly, your With/End With are irrelevant, you're not using WS3 at all here. They can go. They don't do any harm because they don't do anything. Everything inside this wrapper refers to everything in relation to rng anyway.
More importantly though, you're writing to cells using rng.Parent.Cells(LastRow, X)
So you refer to the table's range (called rng), then you go to it's .Parent which will be the sheet that Table2 sits on and then from cell A1 you find the cell using LastRow and x.
Now previously, LastRow examines the WS3 sheet to find the last cell/row used, not the rng or Table2 - so you'll be writing to the row based on WS3, regardless of where rng sits.
If you can advise WHERE Table1 and Table2 are (which sheet, top left cell address) I think I might be able to update this but right now I'd be guessing.