Transfer User form data to Worksheet not as expected.

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
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.


Code:
 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
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Check out screen shot here.
2882.jpg
 
Upvote 0
Do you have any conditional formatting?
 
Upvote 0
I put this together and with some help from people here for the code but im sure i never used any C-Formatting.
 
Upvote 0
I was just asking because conditional formatting takes priority over any normal formatting which would have explained the yellow fill color not sticking and the borders disappearing but if you haven't got any then that obviously isn't the answer.
 
Upvote 0
Perhaps copy/paste formatting after inserting the row
Code:
    ws.Range("A6").EntireRow.Insert
    ws.Rows(7).Copy
    ws.Rows(6).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
 
Upvote 0
Ive found this code below,does that point to anything ?

Code:
Private Sub Imageline_Click()Rows("6:6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M6").Value = Date
Range("A6").Select
End Sub
 
Upvote 0
I don't find that in the code you posted, but I do find ws.Range("A6").EntireRow.Insert
 
Upvote 0

Forum statistics

Threads
1,215,235
Messages
6,123,779
Members
449,123
Latest member
StorageQueen24

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top