PDA

View Full Version : Format textbox to numbers in Userform



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

Benzadeus
09-02-2009, 06:49 AM
Use, for example:

Cells(R, 29) = CCur(Me.SuppSpent07)
Cells(R, 30) = CCur(Me.SuppSpent08)
Cells(R, 31) = CCur(Me.SuppSpent09)
Cells(R, 32) = CCur(Me.SuppSpent10)

lhtqasonline
09-02-2009, 07:18 AM
Hi

I get error Run-time error '13':
Type mismatch

Benzadeus
09-02-2009, 07:22 AM
You are getting error because the paramethers Me.SuppSpent07, and/or Me.SuppSpent08, and/or Me.SuppSpent09, and/or Me.SuppSpent10 are not numbers.

lhtqasonline
09-02-2009, 07:31 AM
I tried it with formatting the cells on worksheets as numbers and as currency and get the same error on the first

Cells(R, 29) = CCur (Me.SuppSpent07)

Benzadeus
09-02-2009, 12:24 PM
I don't know why you are getting the error, because it works fine for me.

rbrhodes
09-02-2009, 03:07 PM
Perhaps a test:



'//Test
if not isnumeric(me.SuppSpent07) then
msgbox(me.supportSpent07 & " is not a number!")
end if

lhtqasonline
09-04-2009, 12:48 AM
Hi
Can anyone help in how I can write VBA code to simulate the convert text to numbers function when Excel gives you that error/dropdown option to change the cell value to a number?

Benzadeus
09-04-2009, 03:46 AM
Sub Convert_to_Values()

Dim rng As Range

For Each rng In Selection
rng = rng.Value
Next rng

Set rng = Nothing
End Sub

lhtqasonline
09-04-2009, 05:05 AM
That just hangs my PC is it intended for one cell or a column of data?

mdmackillop
09-04-2009, 05:26 AM
Continued here (http://vbaexpress.com/forum/showthread.php?t=28309)