Userform to worksheet properties advice

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Morning,
I am using the supplied code on my userform which works fine but need to ask for some advice if i may.

Im having an issue now & then with the format of my worksheet so ive decided that i need to apply fonts / size etc etc when the data from the userform is sent to the worksheet.

I wish to add properties like example below but i dont need the Range A1 i need it applied for the row its going to be sent to from the userform,
I can apply the font,size,bold,horizontal alignment etc etc but can you advise where i also need to place it in my code

Range("A1").Font.Color = vbRed
Range("A1").Font.Bold = True

Many Thanks

VBA Code:
Private Sub PostageSheetTransferButton_Click()
Cancel = 0
If TextBox2.Text = "" Then
    Cancel = 1
    MsgBox "Customer`s Name Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox2.SetFocus
    
ElseIf TextBox3.Text = "" Then
    Cancel = 1
    MsgBox "Item Description Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox3.SetFocus
    
ElseIf TextBox4.Visible = True And TextBox4.Text = "" Then
    Cancel = 1
    MsgBox "Tracking Number Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox4.SetFocus
    
ElseIf OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Ebay Account", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Origin", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf OptionButton7.Value = False And OptionButton8.Value = False And OptionButton9.Value = False And OptionButton10.Value = False And OptionButton11.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Postal Company", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf OptionButton12.Value = False And OptionButton13.Value = False Then
    Cancel = 1
    MsgBox "YOU MUST SELECT A USER NAME OPTION", vbCritical, "POSTAGE TRANSFER SHEET"
      
    
End If

If Cancel = 1 Then
        Exit Sub
End If

Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim LastRow As Long
LastRow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.Count, 1).End(xlUp).Row
    

    
 With ThisWorkbook.Worksheets("POSTAGE")
    .Cells(LastRow + 1, 1).Value = TextBox1.Text
    .Cells(LastRow + 1, 2).Value = TextBox2.Text
    .Cells(LastRow + 1, 3).Value = TextBox3.Text
    .Cells(LastRow + 1, 5).Value = TextBox4.Text
    .Cells(LastRow + 1, 4).Value = TextBox6.Text
    .Cells(LastRow + 1, 9).Value = TextBox9.Text
    .Cells(LastRow + 1, 7).Value = "POSTED"
    If OptionButton1.Value = True Then .Cells(LastRow + 1, 8).Value = "DR": OptionButton1.Value = False
    If OptionButton2.Value = True Then .Cells(LastRow + 1, 8).Value = "IVY": OptionButton2.Value = False
    If OptionButton3.Value = True Then .Cells(LastRow + 1, 8).Value = "N/A": OptionButton3.Value = False
    If OptionButton4.Value = True Then .Cells(LastRow + 1, 6).Value = "EBAY": OptionButton4.Value = False
    If OptionButton5.Value = True Then .Cells(LastRow + 1, 6).Value = "WEB SITE": OptionButton5.Value = False
    If OptionButton6.Value = True Then .Cells(LastRow + 1, 6).Value = "N/A": OptionButton6.Value = False
    If OptionButton7.Value = True Then .Cells(LastRow + 1, 10).Value = "ROYAL MAIL": OptionButton7.Value = False
    If OptionButton8.Value = True Then .Cells(LastRow + 1, 10).Value = "DHL": OptionButton8.Value = False
    If OptionButton9.Value = True Then .Cells(LastRow + 1, 10).Value = "MY HERMES": OptionButton9.Value = False
    If OptionButton10.Value = True Then .Cells(LastRow + 1, 7).Value = "COLLECTION"
    If OptionButton10.Value = True Then .Cells(LastRow + 1, 10).Value = "COLLECTION": OptionButton10.Value = False
    If OptionButton11.Value = True Then .Cells(LastRow + 1, 10).Value = "N/A": OptionButton11.Value = False
    If OptionButton12.Value = True Then .Cells(LastRow + 1, 9).Value = "N/A": OptionButton12.Value = False

    
    
Dim colorHTML As String, r As String, g As String, b As String
        If MsgBox("HAS THE SECURITY MARK BEEN APPLIED ?", vbYesNo + vbExclamation, "PINK SECURITY MARK MESSAGE") = vbYes Then
        TextBox1.Value = ""
        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox6.Value = ""
        TextBox9.Value = ""
        .Cells(LastRow + 1, 11).Value = "YES"
        

End If
        MsgBox "CUSTOMER POSTAGE SHEET HAS NOW BEEN UPDATED", vbInformation, "SUCCESSFUL UPDATE MESSAGE"
        Application.Goto Sheets("POSTAGE").Range("B" & Rows.Count).End(xlUp), True

err:
 Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\"
    If ActiveCell.Column = Columns("B").Column Then
 
    If Len(Dir(FILE_PATH & ActiveCell.Value & ".jpg")) Then
        ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".jpg"
        MsgBox "CUSTOMER PHOTO HYPERLINK WAS SUCCESSFUL.", vbInformation, "POSTAGE SHEET HYPERLINK MESSAGE"
        End If
        
        Else
        MsgBox "PLEASE SELECT A CUSTOMER FIRST TO HYPERLINK THE PHOTO.", vbCritical, "POSTAGE SHEET HYPERLINK MESSAGE"
        Exit Sub
        End If
        
        If Dir(FILE_PATH & ActiveCell.Value & ".jpg") = "" Then
        If MsgBox("THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER" & vbCrLf & vbCrLf & _
        "WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?" & vbCrLf & vbCrLf & _
        "YES = OPEN THE PHOTO FOLDER" & vbCrLf & vbCrLf & _
        "NO = HYPERLINK IS NOT REQUIRED", vbYesNo + vbCritical, "HYPERLINK CUSTOMER MISSING PHOTO MESSAGE.") = vbYes Then
        
        CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
        MsgBox "CONTINUE TO NOW HYPERLINK CUSTOMER & PHOTO ?", vbInformation, "HYPERLINK PHOTO MESSAGE"
        
        GoTo err
        End If

    
    End If
    

End With
    
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox1.Value = Now
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox6.Value = ""
TextBox9.Value = ""
TextBox2.SetFocus

NameForDateEntryBox.Clear
UserForm_Initialize
End Sub
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Hi,
Ive applied the code in Red shown below which does what i require BUT it freezes up the PC because it applies the whole worksheet of some 1200 rows as opposed to just the new row being inserted.

Please can you advise my mistake

Rich (BB code):
 With ThisWorkbook.Worksheets("POSTAGE")
    .Cells(LastRow + 1, 1).Value = TextBox1.Text
    .Cells(LastRow + 1, 2).Value = TextBox2.Text
    .Cells(LastRow + 1, 3).Value = TextBox3.Text
    .Cells(LastRow + 1, 5).Value = TextBox4.Text
    .Cells(LastRow + 1, 4).Value = TextBox6.Text
    .Cells(LastRow + 1, 9).Value = TextBox9.Text
    .Cells(LastRow + 1, 7).Value = "POSTED"
    If OptionButton1.Value = True Then .Cells(LastRow + 1, 8).Value = "DR": OptionButton1.Value = False
    If OptionButton2.Value = True Then .Cells(LastRow + 1, 8).Value = "IVY": OptionButton2.Value = False
    If OptionButton3.Value = True Then .Cells(LastRow + 1, 8).Value = "N/A": OptionButton3.Value = False
    If OptionButton4.Value = True Then .Cells(LastRow + 1, 6).Value = "EBAY": OptionButton4.Value = False
    If OptionButton5.Value = True Then .Cells(LastRow + 1, 6).Value = "WEB SITE": OptionButton5.Value = False
    If OptionButton6.Value = True Then .Cells(LastRow + 1, 6).Value = "N/A": OptionButton6.Value = False
    If OptionButton7.Value = True Then .Cells(LastRow + 1, 10).Value = "ROYAL MAIL": OptionButton7.Value = False
    If OptionButton8.Value = True Then .Cells(LastRow + 1, 10).Value = "DHL": OptionButton8.Value = False
    If OptionButton9.Value = True Then .Cells(LastRow + 1, 10).Value = "MY HERMES": OptionButton9.Value = False
    If OptionButton10.Value = True Then .Cells(LastRow + 1, 7).Value = "COLLECTION"
    If OptionButton10.Value = True Then .Cells(LastRow + 1, 10).Value = "COLLECTION": OptionButton10.Value = False
    If OptionButton11.Value = True Then .Cells(LastRow + 1, 10).Value = "N/A": OptionButton11.Value = False
    If OptionButton12.Value = True Then .Cells(LastRow + 1, 9).Value = "N/A": OptionButton12.Value = False
    .Cells.Font.Bold = True
    .Cells.Font.Name = "Calibri"
    .Cells.Font.Size = 12
    .Cells.RowHeight = 25
    .Cells.HorizontalAlignment = xlCenter
    .Cells.Font.Color = vbBlack

    
    
Dim colorHTML As String, r As String, g As String, b As String
        If MsgBox("HAS THE SECURITY MARK BEEN APPLIED ?", vbYesNo + vbExclamation, "PINK SECURITY MARK MESSAGE") = vbYes Then
        TextBox1.Value = ""
        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox6.Value = ""
        TextBox9.Value = ""
        .Cells(LastRow + 1, 11).Value = "YES"
 
Upvote 0

Forum statistics

Threads
1,214,594
Messages
6,120,436
Members
448,964
Latest member
Danni317

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