Userform sends to two worksheets - Positioning issues

[joeforton]

I have created a VBA Userform to send data to the main database worksheet (Database) as well as a table on a new worksheet (New Entries) that is used to temporarily store information until after the Userform is closed. The data from the Userform correctly adds to the database worksheet (Database) in the correct position, but on the second worksheet (New Entries) the Userform mimics the row position of sheet1 (Database) instead of starting at the top row of the table. How can I get the Userform (once opened) to start at the top row of the sheet2 (New Entries) table? I may have up to 19 data rows in this table range (A3:M21).

Below is the code that works perfectly well, except for the positioning of the "New Entries" worksheet table:




Sub Reset()

Dim iRow As Long

iRow = [Counta(Database!A:A)] 'Identifying the last row


With frmForm

.txtLegalName.Value = ""
.txtTransitionDate.Value = ""
.txtAccountID.Value = ""
.optCAM.Value = False
.optAM.Value = False
.txtCurrentManager.Value = ""
.txtTransitioningTo.Value = ""

.cmbDivision.Clear

.cmbDivision.AddItem "Brevard"
.cmbDivision.AddItem "Gainesville"
.cmbDivision.AddItem "Jacksonville"
.cmbDivision.AddItem "Ocala"
.cmbDivision.AddItem "Orlando"
.cmbDivision.AddItem "Sarasota"
.cmbDivision.AddItem "Tampa"
.cmbDivision.AddItem "Volusia"


.cmbAssociationType.Clear

.cmbAssociationType.AddItem "SFH"
.cmbAssociationType.AddItem "TownHomes"
.cmbAssociationType.AddItem "Mixed"
.cmbAssociationType.AddItem "Condo"
.cmbAssociationType.AddItem "Commercial"
.cmbAssociationType.AddItem "POA"
.cmbAssociationType.AddItem "Villas"
.cmbAssociationType.AddItem "Other"



.txtUnitCount.Value = ""
.optFull.Value = False
.optActOnly.Value = False
.txtLastManagerChange.Value = ""
.txtCAMSenior.Value = ""
.txtAMSenior.Value = ""


.lstDatabase.ColumnCount = 13
.lstDatabase.ColumnHeads = True


.lstDatabase.ColumnWidths = "125,60,55,25,40,50,50,60,25,45,40"



If iRow > 1 Then

.lstDatabase.RowSource = "Database!A2:M" & iRow
Else

.lstDatabase.RowSource = "Database!A2:M2"




End If




End With


End Sub


Sub Submit()

Dim sh As Worksheet
Dim iRow As Long

Set sh = ThisWorkbook.Sheets("Database")

iRow = [Counta(Database!A:A)] + 1


With sh


.Cells(iRow, 1) = iRow + 1

.Cells(iRow, 1) = frmForm.txtLegalName.Value

.Cells(iRow, 2) = frmForm.txtTransitionDate.Value

.Cells(iRow, 3) = frmForm.txtAccountID.Value

.Cells(iRow, 4) = IIf(frmForm.optCAM.Value = True, "CAM", "AM")

.Cells(iRow, 5) = frmForm.txtCurrentManager.Value

.Cells(iRow, 6) = frmForm.txtTransitioningTo.Value

.Cells(iRow, 7) = frmForm.cmbDivision.Value

.Cells(iRow, 8) = frmForm.cmbAssociationType.Value

.Cells(iRow, 9) = frmForm.txtUnitCount.Value

.Cells(iRow, 10) = IIf(frmForm.optFull.Value = True, "CAM", "AM")

.Cells(iRow, 11) = frmForm.txtLastManagerChange.Value

.Cells(iRow, 12) = frmForm.txtCAMSenior.Value

.Cells(iRow, 13) = frmForm.txtAMSenior.Value

End With






Set sh = ThisWorkbook.Sheets("New Entries")

'Will enter on top row but will then be overwritten
iRow = [Counta(New Entries!A)] + 2


'Will enter all data but in middle of table (mimics database positioning)
'Range("A" & Rows.Count).End(xlUp).Offset(1).Select


With sh


.Cells(iRow, 1) = iRow - 1

.Cells(iRow, 1) = frmForm.txtLegalName.Value

.Cells(iRow, 2) = frmForm.txtTransitionDate.Value

.Cells(iRow, 3) = frmForm.txtAccountID.Value

.Cells(iRow, 4) = IIf(frmForm.optCAM.Value = True, "CAM", "AM")

.Cells(iRow, 5) = frmForm.txtCurrentManager.Value

.Cells(iRow, 6) = frmForm.txtTransitioningTo.Value

.Cells(iRow, 7) = frmForm.cmbDivision.Value

.Cells(iRow, 8) = frmForm.cmbAssociationType.Value

.Cells(iRow, 9) = frmForm.txtUnitCount.Value

.Cells(iRow, 10) = IIf(frmForm.optFull.Value = True, "CAM", "AM")

.Cells(iRow, 11) = frmForm.txtLastManagerChange.Value

.Cells(iRow, 12) = frmForm.txtCAMSenior.Value

.Cells(iRow, 13) = frmForm.txtAMSenior.Value


End With




End Sub





Sub Show_Form()

frmForm.Show

End Sub

 

[joeforton]

Good morning,

I have added a link to my document which shows a userform on the homepage which sends data to the Database worksheet as well as the New Entries worksheet. The code for the entire workbook is functional except for the New Entries worksheet where the data is not being added correctly. The New Entries worksheet is being used as a temporary table which is then captured in an email (code is also included and is functional). I need the data from the userform to go into the New Entries table in an orderly fashion starting at the top row (which is cleared when the userform is re-initiated). Below the table range is an area that has conditional formatting that will show only when data appears on the temporary table. This is what will appear on the email when it is generated by the form. If there is a solution to this issue, I would certainly appreciate your help. Thanks very much!!

Manager Transitions Mr Excel.xlsm | Powered by Box

app.box.com

 

[NoSparks]

In the Submit macro, replace this part

    Set sh = ThisWorkbook.Sheets("New Entries")
                      
           
'Will enter on top row but will then be overwritten
iRow = [Counta(New Entries!A)] + 2

        
'Will enter all data but will match row from Database worksheet
'Range("A" & Rows.Count).End(xlUp).Offset(1).Select

with this

    Set sh = ThisWorkbook.Sheets("New Entries")
    iRow = 0
    On Error Resume Next
    iRow = sh.Range("A3:A20").Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
    On Error GoTo 0
    If iRow = 0 Then
        iRow = 3
    Else
        iRow = iRow + 1
    End If

and when you exceed 19 entries it will keep over-writing to row 21

Hope that helps

 

[joeforton]

In the Submit macro, replace this part

    Set sh = ThisWorkbook.Sheets("New Entries")
                     
          
'Will enter on top row but will then be overwritten
iRow = [Counta(New Entries!A)] + 2

       
'Will enter all data but will match row from Database worksheet
'Range("A" & Rows.Count).End(xlUp).Offset(1).Select

with this

    Set sh = ThisWorkbook.Sheets("New Entries")
    iRow = 0
    On Error Resume Next
    iRow = sh.Range("A3:A20").Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
    On Error GoTo 0
    If iRow = 0 Then
        iRow = 3
    Else
        iRow = iRow + 1
    End If

and when you exceed 19 entries it will keep over-writing to row 21

Hope that helps

This is FANTASTIC! This is exactly what I needed. It works perfectly. Thank you very much for your help!

 

[NoSparks]

You're welcome, glad I could assist.