Code for font size to be saved & over ride the default

[ipbr21054]

Hi,
I have supplied the whole code as i am a bit confused as to what part to target.
Here is an example,

Lets assume that i have the database open & all the fields have data in.
The field in question is Invoice Number which is txtInvoiceNumber & currently shows 500
I now need to change the 500 with say 501.
I change the figure then i press "save changes for this customer" it changes fine & i see the msgbox telling me "changes saved successfully"

The problem i see is when i close the database & revert back to my worksheet the cell in column P for that specific customer "which is where the value is" has a small font of 11 where i need it to be 16
Basically in a nut shell when i press "save changes for this customer" make it save to font 16 on my worksheet

 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
End Sub


Private Sub NewRecord_Click()
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    
    IsNewCustomer = CBool(Me.NewRecord.Tag)
    
        If Not IsNewCustomer Then
        If MsgBox("Are you sure you wish to cancel these new customer details?", 36, "Cancel New Customer Details") = vbNo Then Exit Sub
    End If
    
    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 OpenInvoice_Click()


    Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\"
    
    If txtInvoiceNumber = "N/A" Or Len(txtInvoiceNumber) = 0 Then
                MsgBox "Invoice N/A For This Customer", vbExclamation, "N/A INVOICE NOTICE"
    Else
        If Len(Dir(FILE_PATH & txtInvoiceNumber.Value & ".pdf")) = 0 Then
            If MsgBox("Would You Like To Open The Folder ?", vbCritical + vbYesNo, "Warning Invoice is Missing.") = vbYes Then
                CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\")
            End If
        Else
            CreateObject("Shell.Application").Open (FILE_PATH & txtInvoiceNumber.Value & ".pdf")
        End If
    End If
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
If Not IsComplete(Form:=Me) Then Exit Sub
Dim IsNewCustomer As Boolean
'New Part
 Dim ctrl As MSForms.Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is MSForms.TextBox Then ctrl.BackColor = RGB(255, 255, 255)
    Next ctrl
'End New part


    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"
              Cells(C.Row, "Q").Value = TextBox1 '<<<<<<<<<<<<<<
              Exit Sub
        End If
    End If
    
    IsNewCustomer = CBool(Me.UpdateRecord.Tag)
       
    msg = "CHANGES SAVED SUCCESSFULLY"
        
    If IsNewCustomer Then
    'New record - check all fields entered
        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
            If .Text = "" Then
                     MsgBox .Name & " is empty!"
                     Exit Sub
                End If
                ws.Cells(r, i).Value = Val(.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
        Range("A6:Q6").Interior.ColorIndex = 6
        
        With Sheets("DATABASE")
            If .AutoFilterMode Then .AutoFilterMode = False
            x = .Cells(.Rows.Count, 1).End(xlUp).Row
                .Range("A5:Q" & x).Sort key1:=.Range("A6"), order1:=xlAscending, Header:=xlGuess
                Range("A6:Q6").Borders.LineStyle = xlContinuous
                Range("A6:Q6").Borders.Weight = xlThin
            
       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"
Unload Me


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

 

[NdNoviceHlp]

ws.Cells(r, i).Font.Size = 16

HTH. Dave

 

[ipbr21054]

Could you high lite my code please to show me where i need to put it

Thansk

 

[NdNoviceHlp]

Your code already has it. It just says, oddly enough, to set the font to 11 Dave

 

[ipbr21054]

Are you refering to the code at the end as shown here ?

If so that alters all that row in question.
I need font 11 for cells in columns A-O
But font 16 for the cell in column P

        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
            If .Text = "" Then
                     MsgBox .Name & " is empty!"
                     Exit Sub
                End If
                ws.Cells(r, i).Value = Val(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11

 

[NdNoviceHlp]

Well then trial this (if it's the same row)...

ws.Cells(r, "P").Font.Size = 16

Dave

 

[ipbr21054]

That worked thanks.

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave