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

 

[MARK858]

What that code you posted does is it inserts a new row at row 6, so the old row is now row 7 and copies the formatting from row 5 to the new row 6 (and inserts a date in M6 but that is irrelevant at the moment).

But from what I can see in the image it appears that at least some of the columns in row 5 A-G have borders and so that wouldn't explain the image in post #2 but I notice that in the image in post #10 rows 6 to 10 now appear to have some borders

 

[NoSparks]

With my testing CopyOrigin did not include the borders hence the suggestion of post #6

 

[MARK858]

With my testing CopyOrigin did not include the borders hence the suggestion of post #6

I agree I just tested it and the interior.color and fonts get copied but not the borders.

I also notice that row 8 now doesn't have the blue color. What happens if you put a 1 in H7 and H8?

 

[ipbr21054]

Good.
Could you advise within the code where i need to put it.

 

[ipbr21054]

I put the code you mentioned in post 6 after that code you mentioned in this post but no borders still.
Did i do it wrong or please advise.

Thanks all

 

[ipbr21054]

I have placed the code where i think it should go,see code below please and advise if correct place.

I then did A test as shown below but please now take a look at row 6 & 7 & 8

 

[NoSparks]

Use the F9 key to toggle a break point near the start of your Sub UpdateRecord_Click().
Run your user form as normal.
When the VBA environment comes up its execution will be stopped at the break point.
Hit the Windows Key and Right Arrow Key at the same time.
You should now see part of both the sheet and VBE on your screen.
Execute the code with the F8 key one line at a time from the break point on and observe what happens on the sheet.

Should be obvious what's happening.

 

[ipbr21054]

I have followed the above.
After both the sheet & vbe is on my screen i still also have the user form open at this point as i have not clicked on save new customer etc as the execution was stopped.
I then see the code shown in Yellow & i press F8 the Yellow then moves down the code bit by bit but nothing else is happening in respect of the user form & worksheet.
The user form is still open at this point & i assumed it might of closed for the data to now be entered into the worksheet & show me whats going on ?

If not im lost sorry.

 

[NoSparks]

The code snippet of post #6, is 3 lines of code added below your existing line of code that inserts the new row 6.

Your formatting is not right because the original row 6 is not formatted as wanted.
Once you insert the new row 6, the original row 6 becomes row 7 and that's the formatting being copied.

 

[ipbr21054]

Ok,
So ive read that 3 times but i would be lying to say i now know what the code should be to fix it.