austenr
06-05-2005, 02:28 PM
This is a routine that collects information from a user form and write a row to a database. The question is why are the columns group number and member count written as text and not number? In order to do a subtotal on those columns I have to convert the cell contents to numbers. How can I write them as numbers instead of text? Thanks
Option Explicit
Dim iRowNumber As Integer
Dim LastRow As Integer, Row As Integer
Private Sub btnRestore_Click()
Call GetData
End Sub
Private Sub CommandButton1_Click()
Call PutData
Range("DataBase").Resize(Range("Database").Rows.Count + 1).Name = "Database"
iRowNumber = Range("Database").Rows.Count
Call GetData
TextA.SetFocus
ScrollBar1.Max = Range("Database").Rows.Count
ScrollBar1.Value = iRowNumber
lblRecNumber.Caption = iRowNumber - 1
End Sub
Private Sub CommandButton2_Click()
If Range("Database").Rows.Count = 2 Then
MsgBox "You cannot delete last record", vbExclamation
Exit Sub
End If
If MsgBox("Are you sure you want to delete this record?", vbQuestion + vbOKCancel) = vbCancel Then Exit Sub
Range("DataBase").Rows(iRowNumber).EntireRow.Delete
If iRowNumber > Range("Database").Rows.Count Then
iRowNumber = Range("Database").Rows.Count
End If
Call GetData
ScrollBar1.Enabled = False
ScrollBar1.Value = iRowNumber
ScrollBar1.Max = Range("Database").Rows.Count
lblRecNumber.Caption = iRowNumber - 1
End Sub
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub CommandButton5_Click()
PrintGroupList
End Sub
Private Sub ScrollBar1_Change()
iRowNumber = ScrollBar1.Value
Call GetData
TextA.SetFocus
lblRecNumber.Caption = iRowNumber - 1
End Sub
Private Sub TextA_Change()
Me.EditEntry
End Sub
Private Sub TextB_Change()
Me.EditEntry
End Sub
Private Sub TextC_Change()
Me.EditEntry
End Sub
Private Sub TextD_Change()
Me.EditEntry
End Sub
Private Sub UserForm_Activate()
iRowNumber = Range("lastRecordNumber")
If iRowNumber > Range("Database").Rows.Count Then iRowNumber = Range("Database").Rows.Count
Call GetData
ScrollBar1.Value = iRowNumber
ScrollBar1.Max = Range("Database").Rows.Count
End Sub
Sub EditEntry()
......
End Sub
Sub GetData()
With Me
.TextA = Range("DataBase").Cells(iRowNumber, 1)
.TextB = Range("DataBase").Cells(iRowNumber, 2)
.TextC = Range("DataBase").Cells(iRowNumber, 3)
.TextD = Range("DataBase").Cells(iRowNumber, 4)
End With
End Sub
Sub PutData()
With Me
Range("DataBase").Cells(iRowNumber, 1) = .TextA
Range("DataBase").Cells(iRowNumber, 2) = .TextB
Range("DataBase").Cells(iRowNumber, 3) = .TextC
Range("DataBase").Cells(iRowNumber, 4) = .TextD
End With
SortDataList
End Sub
Sub SortDataList() '\sorts the data list after new row is entered
With Range("DataBase").Parent
.Range("A2:D65536").Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call PutData
Call DeleteBlankRows
Range("lastRecordNumber") = iRowNumber
End Sub
Option Explicit
Dim iRowNumber As Integer
Dim LastRow As Integer, Row As Integer
Private Sub btnRestore_Click()
Call GetData
End Sub
Private Sub CommandButton1_Click()
Call PutData
Range("DataBase").Resize(Range("Database").Rows.Count + 1).Name = "Database"
iRowNumber = Range("Database").Rows.Count
Call GetData
TextA.SetFocus
ScrollBar1.Max = Range("Database").Rows.Count
ScrollBar1.Value = iRowNumber
lblRecNumber.Caption = iRowNumber - 1
End Sub
Private Sub CommandButton2_Click()
If Range("Database").Rows.Count = 2 Then
MsgBox "You cannot delete last record", vbExclamation
Exit Sub
End If
If MsgBox("Are you sure you want to delete this record?", vbQuestion + vbOKCancel) = vbCancel Then Exit Sub
Range("DataBase").Rows(iRowNumber).EntireRow.Delete
If iRowNumber > Range("Database").Rows.Count Then
iRowNumber = Range("Database").Rows.Count
End If
Call GetData
ScrollBar1.Enabled = False
ScrollBar1.Value = iRowNumber
ScrollBar1.Max = Range("Database").Rows.Count
lblRecNumber.Caption = iRowNumber - 1
End Sub
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub CommandButton5_Click()
PrintGroupList
End Sub
Private Sub ScrollBar1_Change()
iRowNumber = ScrollBar1.Value
Call GetData
TextA.SetFocus
lblRecNumber.Caption = iRowNumber - 1
End Sub
Private Sub TextA_Change()
Me.EditEntry
End Sub
Private Sub TextB_Change()
Me.EditEntry
End Sub
Private Sub TextC_Change()
Me.EditEntry
End Sub
Private Sub TextD_Change()
Me.EditEntry
End Sub
Private Sub UserForm_Activate()
iRowNumber = Range("lastRecordNumber")
If iRowNumber > Range("Database").Rows.Count Then iRowNumber = Range("Database").Rows.Count
Call GetData
ScrollBar1.Value = iRowNumber
ScrollBar1.Max = Range("Database").Rows.Count
End Sub
Sub EditEntry()
......
End Sub
Sub GetData()
With Me
.TextA = Range("DataBase").Cells(iRowNumber, 1)
.TextB = Range("DataBase").Cells(iRowNumber, 2)
.TextC = Range("DataBase").Cells(iRowNumber, 3)
.TextD = Range("DataBase").Cells(iRowNumber, 4)
End With
End Sub
Sub PutData()
With Me
Range("DataBase").Cells(iRowNumber, 1) = .TextA
Range("DataBase").Cells(iRowNumber, 2) = .TextB
Range("DataBase").Cells(iRowNumber, 3) = .TextC
Range("DataBase").Cells(iRowNumber, 4) = .TextD
End With
SortDataList
End Sub
Sub SortDataList() '\sorts the data list after new row is entered
With Range("DataBase").Parent
.Range("A2:D65536").Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call PutData
Call DeleteBlankRows
Range("lastRecordNumber") = iRowNumber
End Sub