Add to external Excel database

[COwen]

I am trying to add to add date from a Userform on one workbook to another workbook that holds my data. Here is the code I have currently:

Private Sub imgGenerate_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim x As Integer
With Sheet12 'Worksheets("Sample Router")
    .Range("INV").Value = cntrl5.Value
    .Range("SON").Value = cntrl6.Value
    .Range("Cust").Value = cntrl8.Value
    .Range("IDate").Value = cntrl7.Value
    .Range("EDate").Value = cntrl4.Value
    .Range("RouterX").Value = (.Range("RouterX").Value + 1)
    '.Range("A1:O62").PrintOut
End With
On Error GoTo Err
Application.ScreenUpdating = False

    With Application
        .DisplayAlerts = False
        .Visible = False
        .ScreenUpdating = False
    End With
    
    Set wb = Workbooks.Open(Filename:="C:\Users\caleb.owen\Documents\Cordial FileTracker tobezip\XLDataBaseforCordial.xlsm")
    Set ws = wb.Worksheets("Sheet1")
    
    'find first empty row in database
    'iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    'copy the data to the database
    ws.Cells(iRow, 0).Value = Me.cntrl1.Value
    ws.Cells(iRow, 2).Value = Me.cntrl2.Value
    ws.Cells(iRow, 3).Value = Me.cntrl5.Value
    ws.Cells(iRow, 4).Value = Me.cntrl6.Value
    ws.Cells(iRow, 5).Value = Me.cntrl7.Value
    ws.Cells(iRow, 6).Value = Me.cntrl8.Value
    ws.Cells(iRow, 7).Value = Me.cntrl4.Value
    ws.Cells(iRow, 8).Value = Me.cntrl9.Value
    ws.Cells(iRow, 9).Value = Me.cntrl3.Value
    ws.Cells(iRow, 10).Value = Me.cntrl10.Value
Err:
    Workbooks("XLDataBaseforCordial.xlsm").Close True
    
With Sheet12 'Worksheets("Sample Router")
    .Range("INV").Value = ""
    .Range("SON").Value = ""
    .Range("Cust").Value = ""
    .Range("IDate").Value = ""
    .Range("EDate").Value = ""
End With
cntrl2.Value = Sheet12.Range("RouterV").Value
For x = 5 To 10
Me.Controls("cntrl" & x).Value = ""
Next x
End Sub

It is not populating correctly at all. It will only add the data to the first line then it will stop.

 

[Fluff]

What error do you get & what line gets highlighted?

 

[COwen]

As I said. It just crashes. No message, no debugging. Just gray.

 

[Fluff]

Try stepping through it using F8 & see what happens.

 

[COwen]

It is jumping to this code:

Sub PrimaryKey()

Dim wb As Workbook
Dim ws As Worksheet

    With Application
        .DisplayAlerts = False
        .Visible = False
        .ScreenUpdating = False
    End With
    
    Set wb = Workbooks.Open(Filename:="C:\Users\caleb.owen\Documents\Cordial FileTracker tobezip\XLDataBaseforCordial.xlsm")
    Set ws = wb.Worksheets("Sheet1")
If ws.Range("A2").Value = "" Or ws.Range("A3").Value = "" Then
ws.Range("A2").Value = 1
End If
frmRouter.cntrl1.Value = (Application.WorksheetFunction.Max(ws.Range("PrimaryKey")) + 1)
Workbooks("XLDataBaseforCordial.xlsm").Close True


End Sub

and going to ".DisplayAlerts = False"

 

[COwen]

Not really sure what that means.

 

[Fluff]

At what point does it jump to that code?

 

[COwen]

At the ws.Cells(iRow, 0).Value = Me.cntrl1.Value part.

 

[COwen]

Otherwise, stepping through really does not do anything up to that point.

 

[Fluff]

Did you remove the error handler?

 

[COwen]

Well, I commented it out for now.