Transfer User form data to Worksheet not as expected.

[ipbr21054]

Hi,
I have a worksheet where i enter data in cells.The range of the row is A to P
I also have a macro button on the worksheet which opens a form.
I can also enter data into the fields on the form then press a macro button to save to the same worksheet & place it alphabetically in order.
The worksheet cells are filled Yellow.
When on the form & ive completed all the cells i press the macro button Save new customer to database.
I have noticed that it does save the details fine but the cells are only Yellow from A to G and then from H to P are blue ?

Also ive noticed that when the data from the form to worksheet takes place row 6 from A to G looses it border lines but H to P are fine.
This must be linked together somehow but looking through the code a few times i dont see where the problems lies.

I also have another request regarding this form but i would like to clear this issue up first.

Thanks very much if somebody could assist.
Have a nice day.

 Dim ws As Worksheet Dim r As Long
 Dim EventsEnable As Boolean
 Const StartRow As Long = 6


Private Sub ImageClose_Click()
    'close the form (itself)
    Unload Me
End Sub


Private Sub CloseUserForm_Click()
    'close the form (itself)
    Unload Me
End Sub


Private Sub ComboBoxCustomersNames_Change()
    If Not EventsEnable Then Exit Sub
'get record
    r = Me.ComboBoxCustomersNames.ListIndex + StartRow - 1
    Navigate Direction:=0
End Sub


Private Sub ComboBoxCustomersNames_Update()
    With ComboBoxCustomersNames ' change as required
        .RowSource = ""
        .Clear
        .List = ws.Range("A6:A" & ws.Range("A" & Rows.Count).End(xlUp).Row).Value
    End With
End Sub


Private Sub DeleteRecord_Click()


Dim C As Range


With Sheets("DATABASE")
    Set C = .Range("A:A").Find(What:=txtCustomer.Value, _
                        After:=.Range("A5"), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
End With


If Not C Is Nothing Then
    If MsgBox("Are you sure you want to delete the record for " & txtCustomer.Text & "?", vbYesNo + vbCritical) = vbYes Then
        Rows(C.Row).EntireRow.Delete
        MsgBox "The record for " & txtCustomer.Text & " has been deleted!"
    Else
        MsgBox "The record containing customer " & txtCustomer.Text & " was not deleted!"
    End If
Else
    MsgBox "There were no records containing customer " & txtCustomer.Text & " to be deleted"
End If


Set C = Nothing


Unload Me
Database.Show


End Sub


Private Sub NewRecord_Click()
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    
    IsNewCustomer = CBool(Me.NewRecord.Tag)
    
    Navigate Direction:=IIf(IsNewCustomer, xlNone, xlPrevious)


    'if new customer, add Date
    If IsNewCustomer Then
        Me.txtJobDate.Text = Format(Date, "dd/mm/yyyy")
        Me.txtCustomer.SetFocus
    End If
    
    ResetButtons IsNewCustomer


End Sub


Private Sub NextRecord_Click()
    Navigate Direction:=xlNext
End Sub


Private Sub PrevRecord_Click()
    Navigate Direction:=xlPrevious
End Sub
Private Sub UpdateRecord_Click()


Dim C As Range
Dim i As Integer
Dim Msg As String
Dim IsNewCustomer As Boolean




    If Me.NewRecord.Caption = "CANCEL" Then
        With Sheets("DATABASE")
            Set C = .Range("A:A").Find(What:=txtCustomer.Value, _
                                After:=.Range("A5"), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
        End With
        If Not C Is Nothing Then
              MsgBox "Customer already Exists, file did not update"
              Exit Sub
        End If
    End If
    
    IsNewCustomer = CBool(Me.UpdateRecord.Tag)
       
    Msg = "CHANGES SAVED SUCCESSFULLY"
    
    If IsNewCustomer Then
    'New record - check all fields entered
    If Not IsComplete(Form:=Me) Then Exit Sub
        r = StartRow
        Msg = "NEW CUSTOMER SAVED TO DATABASE"
        ws.Range("A6").EntireRow.Insert
        ResetButtons Not IsNewCustomer
        Me.NextRecord.Enabled = True
    End If
    
    On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            ElseIf i = 15 Then
                ws.Cells(r, i).Value = CDbl(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
        End With
    Next i
    
    If IsNewCustomer Then
        Call ComboBoxCustomersNames_Update
        
        With Sheets("DATABASE")
            If .AutoFilterMode Then .AutoFilterMode = False
            x = .Cells(.Rows.Count, 1).End(xlUp).Row
                    .Range("A5:O" & x).Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlGuess
        End With
              
    End If
    
    ThisWorkbook.Save
    
    'tell user what happened
    MsgBox Msg, 48, Msg
    
    Set C = Nothing
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"


End Sub


Sub ResetButtons(ByVal Status As Boolean)
    
    With Me.NewRecord
        .Caption = IIf(Status, "CANCEL", "ADD NEW CUSTOMER TO DATABASE")
        .BackColor = IIf(Status, &HFF&, &H8000000F)
        .ForeColor = IIf(Status, &HFFFFFF, &H0&)
        .Tag = Not Status
    Me.ComboBoxCustomersNames.Enabled = CBool(.Tag)
    End With
    
    With Me.UpdateRecord
        .Caption = IIf(Status, "SAVE NEW CUSTOMER TO DATABASE", "SAVE CHANGES FOR THIS CUSTOMER")
        .Tag = Status
    End With
End Sub


Private Sub Userform_Initialize()
    Set ws = ThisWorkbook.Worksheets("Database")
    
    ComboBoxCustomersNames_Update




    ResetButtons False
    
    'start at first record
    Navigate Direction:=xlFirst
End Sub


Sub Navigate(ByVal Direction As XlSearchDirection)
    Dim i As Integer
    Dim LastRow As Long
    
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    r = IIf(Direction = xlPrevious, r - 1, r + xlNext)
    
    'ensure value of r stays within data range
    If r < StartRow Then r = StartRow
    If r > LastRow Then r = LastRow
    
    'get record
    For i = 1 To UBound(ControlNames)
         Me.Controls(ControlNames(i)).Text = IIf(Direction = xlNone, "", ws.Cells(r, i).Text)
    Next i
    
    Me.Caption = "Database"
    
    'set enabled status of next previous buttons
    Me.NextRecord.Enabled = IIf(Direction = xlNone, False, r < LastRow)
    Me.PrevRecord.Enabled = IIf(Direction = xlNone, False, r > StartRow)
    
    EventsEnable = False
    Me.ComboBoxCustomersNames.ListIndex = IIf(Direction = xlNone, -1, r - StartRow)
    EventsEnable = True




End Sub

 

[NoSparks]

In the code you included in post #1, there is only one occurrance of the word "Insert" in the entire module.
That is where you are inserting the new row 6.
It's this line in the 4th IF statement of Private Sub UpdateRecord_Click()

ws.Range("A6").EntireRow.Insert

Add these 4 lines immediately following that line

    STOP
    ws.Rows(7).Copy
    ws.Rows(6).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False

Run things as you normally would

when the code stops execution and brings up the VBE environment the STOP line will be highlighted yellow

minimize the VBE and see that a new row 6 has been added to the sheet

back to the VBE, F8 should now highlight the ws.Rows(7).Copy line yellow, F8 will execute this line

minimize the VBE and see that row 7 now has the 'marching ants' indicating the line is copied

back to the VBE, F8 will execute the highlighted yellow line ws.Rows(6).PasteSpecial xlPasteFormats

minimize the VBE and see that the formatting has now been pasted to the new row 6

back to the VBE, F8 will execute the highlighted yellow line Application.CutCopyMode = False

minimize the VBA and see that the 'marching ants' disappeared

back to the VBE, comment out STOP and run things normally.


Afraid I'm not able to help more than that.

 

[ipbr21054]

I thank you for your time and effort but i am stumped now with this.
I will leave it as is and not continue.

Thank you