lhtqasonline
09-02-2009, 06:24 AM
Hi all
I have a userform that edits a worksheet with various values.
My problem is that when I type in the textbox on the form and save the userform the cell format changes the current cell format (Currency) to text (stores numbers as text) Can someone help in forcing the cell value to currency when updating the details.
these textboxes value must be currency when I press the button to save the userform values back to the worksheet
Me.SuppSpent07 = Cells(R, 29)
Me.SuppSpent08 = Cells(R, 30)
Me.SuppSpent09 = Cells(R, 31)
Me.SuppSpent10 = Cells(R, 32)
Option Explicit
Private R As Long
Private Declare Function ShellExecute& Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long)
Const SW_SHOWNORMAL = 1
'Private Const SW_SHOW As Long = 5
Private Sub btnClose_Click()
Unload Me
End Sub
Private Sub btnOK_Click()
Dim TxtBxVl As String
If R > 0 Then
Cells(R, 3) = Me.SuppCode
Cells(R, 4) = Me.SuppContact
Cells(R, 5) = Me.SuppTel1
Cells(R, 6) = Me.SuppTel2
Cells(R, 7) = Me.SuppTel3
Cells(R, 8) = Me.SuppCell1
Cells(R, 9) = Me.SuppCell2
Cells(R, 10) = Me.SuppFax
Cells(R, 11) = Me.SuppEmail
Cells(R, 12) = Me.DateContact
Cells(R, 13) = Me.BEntRate
Cells(R, 14) = Me.BEECert
Cells(R, 15) = Me.BEELevel
Cells(R, 16) = Me.VASSelect
Cells(R, 17) = Me.BSholding
Cells(R, 18) = Me.BSPerc
Cells(R, 19) = Me.BWSholding
Cells(R, 20) = Me.BWSPerc
Cells(R, 21) = Me.CertRecv
Cells(R, 22) = Me.CertVal
Cells(R, 23) = Me.BenEntDev
Cells(R, 24) = Me.CompBED
Cells(R, 25) = Me.CBEDContact
Cells(R, 26) = Me.BeCom
Cells(R, 27) = Me.VerAgency
Cells(R, 29) = Me.SuppSpent07
Cells(R, 30) = Me.SuppSpent08
Cells(R, 31) = Me.SuppSpent09
Cells(R, 32) = Me.SuppSpent10
Cells(R, 2) = Me.SuppName
End If
TxtBxVl = UserForm2.DateContact.Value
If IsDate(TxtBxVl) = False Then
MsgBox "Incorrect Date", vbInformation, "Dates"
UserForm2.DateContact.Value = ""
UserForm2.DateContact.SetFocus
Else
Me.DateContact.Value = TxtBxVl
DateContact.Text = Format(CDate(DateContact.Text), "dd/mm/yyyy")
End If
End Sub
Private Sub DateContact_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 8 Then Exit Sub 'for backspace
If (KeyAscii >= 48 And KeyAscii <= 57) Then 'for numbers
Exit Sub
Else
KeyAscii = 0
End If
End Sub
Private Sub DateContact_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'to get value of "/" into system
Dim KeyPrsd As Integer 'number of times key is pressed
Dim PrvEntry As String
KeyPrsd = 0
PrvEntry = UserForm2.DateContact.Value
KeyPrsd = UserForm2.DateContact.TextLength
If KeyPrsd = 2 Or KeyPrsd = 5 Then
UserForm2.DateContact.Text = PrvEntry + "/"
End If
UserForm2.DateContact.SetFocus
End Sub
Private Sub SupName_Change()
R = Application.Match(Me.SupName, Range("B1:B2000"), 0)
Me.SuppName = Cells(R, 2)
Me.SuppCode = Cells(R, 3)
Me.SuppContact = Cells(R, 4)
Me.SuppTel1 = Cells(R, 5)
Me.SuppTel2 = Cells(R, 6)
Me.SuppTel3 = Cells(R, 7)
Me.SuppCell1 = Cells(R, 8)
Me.SuppCell2 = Cells(R, 9)
Me.SuppFax = Cells(R, 10)
Me.SuppEmail = Cells(R, 11)
Me.DateContact = Cells(R, 12)
Me.BEntRate = Cells(R, 13)
Me.BEECert = Cells(R, 14)
Me.BEELevel = Cells(R, 15)
Me.VASSelect = Cells(R, 16)
Me.BSholding = Cells(R, 17)
Me.BSPerc = Cells(R, 18)
Me.BWSholding = Cells(R, 19)
Me.BWSPerc = Cells(R, 20)
Me.CertRecv = Cells(R, 21)
Me.CertVal = Cells(R, 22)
Me.BenEntDev = Cells(R, 23)
Me.CompBED = Cells(R, 24)
Me.CBEDContact = Cells(R, 25)
Me.BeCom = Cells(R, 26)
Me.VerAgency = Cells(R, 27)
Me.SuppSpent07 = Cells(R, 29)
Me.SuppSpent08 = Cells(R, 30)
Me.SuppSpent09 = Cells(R, 31)
Me.SuppSpent10 = Cells(R, 32)
End Sub
Private Sub UserForm_Initialize()
With Me.BEntRate
.AddItem ("<R5m (EME)")
.AddItem ("R5m-R35m (QSE)")
.AddItem (">R35m (Large)")
End With
With Me.BEECert
.AddItem ("Yes")
.AddItem ("No")
.AddItem ("Busy")
End With
With Me.BSholding
.AddItem ("Yes")
.AddItem ("No")
End With
With Me.BWSholding
.AddItem ("Yes")
.AddItem ("No")
End With
With Me.CertRecv
.AddItem ("Recv")
.AddItem ("NotRecv")
End With
With Me.VASSelect
.AddItem ("Yes")
.AddItem ("No")
End With
With Me.BenEntDev
.AddItem ("Yes")
.AddItem ("No")
End With
End Sub
I have a userform that edits a worksheet with various values.
My problem is that when I type in the textbox on the form and save the userform the cell format changes the current cell format (Currency) to text (stores numbers as text) Can someone help in forcing the cell value to currency when updating the details.
these textboxes value must be currency when I press the button to save the userform values back to the worksheet
Me.SuppSpent07 = Cells(R, 29)
Me.SuppSpent08 = Cells(R, 30)
Me.SuppSpent09 = Cells(R, 31)
Me.SuppSpent10 = Cells(R, 32)
Option Explicit
Private R As Long
Private Declare Function ShellExecute& Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long)
Const SW_SHOWNORMAL = 1
'Private Const SW_SHOW As Long = 5
Private Sub btnClose_Click()
Unload Me
End Sub
Private Sub btnOK_Click()
Dim TxtBxVl As String
If R > 0 Then
Cells(R, 3) = Me.SuppCode
Cells(R, 4) = Me.SuppContact
Cells(R, 5) = Me.SuppTel1
Cells(R, 6) = Me.SuppTel2
Cells(R, 7) = Me.SuppTel3
Cells(R, 8) = Me.SuppCell1
Cells(R, 9) = Me.SuppCell2
Cells(R, 10) = Me.SuppFax
Cells(R, 11) = Me.SuppEmail
Cells(R, 12) = Me.DateContact
Cells(R, 13) = Me.BEntRate
Cells(R, 14) = Me.BEECert
Cells(R, 15) = Me.BEELevel
Cells(R, 16) = Me.VASSelect
Cells(R, 17) = Me.BSholding
Cells(R, 18) = Me.BSPerc
Cells(R, 19) = Me.BWSholding
Cells(R, 20) = Me.BWSPerc
Cells(R, 21) = Me.CertRecv
Cells(R, 22) = Me.CertVal
Cells(R, 23) = Me.BenEntDev
Cells(R, 24) = Me.CompBED
Cells(R, 25) = Me.CBEDContact
Cells(R, 26) = Me.BeCom
Cells(R, 27) = Me.VerAgency
Cells(R, 29) = Me.SuppSpent07
Cells(R, 30) = Me.SuppSpent08
Cells(R, 31) = Me.SuppSpent09
Cells(R, 32) = Me.SuppSpent10
Cells(R, 2) = Me.SuppName
End If
TxtBxVl = UserForm2.DateContact.Value
If IsDate(TxtBxVl) = False Then
MsgBox "Incorrect Date", vbInformation, "Dates"
UserForm2.DateContact.Value = ""
UserForm2.DateContact.SetFocus
Else
Me.DateContact.Value = TxtBxVl
DateContact.Text = Format(CDate(DateContact.Text), "dd/mm/yyyy")
End If
End Sub
Private Sub DateContact_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 8 Then Exit Sub 'for backspace
If (KeyAscii >= 48 And KeyAscii <= 57) Then 'for numbers
Exit Sub
Else
KeyAscii = 0
End If
End Sub
Private Sub DateContact_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'to get value of "/" into system
Dim KeyPrsd As Integer 'number of times key is pressed
Dim PrvEntry As String
KeyPrsd = 0
PrvEntry = UserForm2.DateContact.Value
KeyPrsd = UserForm2.DateContact.TextLength
If KeyPrsd = 2 Or KeyPrsd = 5 Then
UserForm2.DateContact.Text = PrvEntry + "/"
End If
UserForm2.DateContact.SetFocus
End Sub
Private Sub SupName_Change()
R = Application.Match(Me.SupName, Range("B1:B2000"), 0)
Me.SuppName = Cells(R, 2)
Me.SuppCode = Cells(R, 3)
Me.SuppContact = Cells(R, 4)
Me.SuppTel1 = Cells(R, 5)
Me.SuppTel2 = Cells(R, 6)
Me.SuppTel3 = Cells(R, 7)
Me.SuppCell1 = Cells(R, 8)
Me.SuppCell2 = Cells(R, 9)
Me.SuppFax = Cells(R, 10)
Me.SuppEmail = Cells(R, 11)
Me.DateContact = Cells(R, 12)
Me.BEntRate = Cells(R, 13)
Me.BEECert = Cells(R, 14)
Me.BEELevel = Cells(R, 15)
Me.VASSelect = Cells(R, 16)
Me.BSholding = Cells(R, 17)
Me.BSPerc = Cells(R, 18)
Me.BWSholding = Cells(R, 19)
Me.BWSPerc = Cells(R, 20)
Me.CertRecv = Cells(R, 21)
Me.CertVal = Cells(R, 22)
Me.BenEntDev = Cells(R, 23)
Me.CompBED = Cells(R, 24)
Me.CBEDContact = Cells(R, 25)
Me.BeCom = Cells(R, 26)
Me.VerAgency = Cells(R, 27)
Me.SuppSpent07 = Cells(R, 29)
Me.SuppSpent08 = Cells(R, 30)
Me.SuppSpent09 = Cells(R, 31)
Me.SuppSpent10 = Cells(R, 32)
End Sub
Private Sub UserForm_Initialize()
With Me.BEntRate
.AddItem ("<R5m (EME)")
.AddItem ("R5m-R35m (QSE)")
.AddItem (">R35m (Large)")
End With
With Me.BEECert
.AddItem ("Yes")
.AddItem ("No")
.AddItem ("Busy")
End With
With Me.BSholding
.AddItem ("Yes")
.AddItem ("No")
End With
With Me.BWSholding
.AddItem ("Yes")
.AddItem ("No")
End With
With Me.CertRecv
.AddItem ("Recv")
.AddItem ("NotRecv")
End With
With Me.VASSelect
.AddItem ("Yes")
.AddItem ("No")
End With
With Me.BenEntDev
.AddItem ("Yes")
.AddItem ("No")
End With
End Sub