with help I have created a form that updates adds scrolls through data on a spread sheet
there are more than 40 textboxes and a couple of combo boxes only 11 of the text boxes show information and the first one updates to the date (todays) every time I update the information (the first text box should be the primary number for sorting the sheet).
I am using 2010 excel and windows 7
what I am trying to get:
a form to edit scroll update or delete information from an excel spread sheet
copy the information from cells I have updated scroll to the next line and past the information to the next line.
add a filter to one of the boxes much the same as filtering data on the spread sheet.
Notes:
there will only be a certain number of text boxes where data will be added most other information won't change.
many thanks if anyone can help
this is the code in the module
Enum XLActionType
xlNew
xlAdd
xlUpdate
xlScrollRow
xlDelete
End Enum
Sub FormData(ByVal Form As Object, ByVal sh As Object, ByVal RecordRow As Long, ByVal Action As XLActionType)
Dim i As Integer
Dim CalDate As Variant
Dim msg As String
Dim ctrl As msforms.Control
On Error GoTo ExitSub
With sh
'add password if required
.Unprotect Password:=""
Select Case Action
Case xlNew
EnableButtons Form:=Form, NewButton:=False, CancelButton:=True, DeleteButton:=False, AddUpdateButton:="Add"
'Form.Calendar.Value = Date
'THERE IS NO CALANDER ON THIS FORM
'clear form
For Each ctrl In Form.Controls
If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then ctrl.Value = ""
Next ctrl
Case xlAdd, xlUpdate
'validate required entry
For Each ctrl In Form.Controls
If Not IsComplete(ctrl) Then GoTo ExitSub
Next ctrl
'For i = 0 To 10 CHANGED THE NO FROM 10 TO 100
For i = 0 To 100
If i = 0 Then
.Cells(RecordRow, 1).Offset(0, i).Value = Form.Controls(ControlArray(i)).Value
Else
.Cells(RecordRow, 1).Offset(0, i).Value = Form.Controls(ControlArray(i)).Value
End If
Next
EnableButtons Form
msg = IIf(Action = xlAdd, "New Record Added To Database", "Record Updated")
MsgBox msg, 48, Left(msg, 16)
Case xlScrollRow
For i = 0 To 10
If i = 0 Then
CalDate = .Cells(RecordRow, 1).Offset(0, i).Value
CalDate = IIf(IsDate(CalDate), CDate(CalDate), Date)
Form.Controls(ControlArray(i)).Value = CalDate
Else
Form.Controls(ControlArray(i)).Value = .Cells(RecordRow, 1).Offset(0, i).Value
End If
Next i
EnableButtons Form
Case xlDelete
Application.EnableEvents = False
.Cells(RecordRow, 1).EntireRow.Delete xlShiftUp
MsgBox "Record Deleted", 48, "Record Deleted"
End Select
'add password if required
'.Protect Password:=""
End With
ExitSub:
Application.EnableEvents = True
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub
Sub EnableButtons(ByVal Form As Object, Optional ByVal NewButton As Boolean = True, Optional ByVal CancelButton As Boolean, _
Optional ByVal DeleteButton As Boolean = True, Optional ByVal AddUpdateButton As String = "Update")
With Form
.ButtonCancel.Enabled = CancelButton
.ButtonNew.Enabled = NewButton
.ButtonDelete.Enabled = DeleteButton
.ButtonAddUpdate.Caption = AddUpdateButton
End With
End Sub
Function ControlArray() As Variant
'ORIGINAL CODING PROBABLY DELET WHEN FINISHED
'ControlArray = Array("Calendar", "TxtBxInfo", "CmboBxSite", _
'"CmboBxProjTitle", "CmboBxJob", "CmboBxServiceObj", _
'"CmboBxObjectives", "CmboBxActionSteps", "CmboBxExpPerform", _
'"CmboBxExceedPer", "TxtBxSupportDoc")
'DELETE OBOVE WHEN FINISHED
ControlArray = Array("TxtBxPrimaryNo", "TxtBxModule", "TxtBxParentFler", _
"TxtbxFler", "TxtBxFlerDescription", "TxtBxAssetclass", "TxtBxCommdate", "TxtBxAssetRepVal", _
"TxtBxReliability", "TxtBxPerformance", "TxtBxExternalCondition", "TxtBxObsolescence", _
"TxtBxOverallCondition", "CmboBxFailuremode", "TxtBxFailureEffects", "TxtBxMTBF", "TxtBxAvgMainCost", _
"TxtBxProductionLossHrs", "TxtBxSafManHrs", "TxtBxRiskYear", "TxtBxUnplannedActual", _
"TxtBxPlannedActual", "TxtBxWk1", "TxtBxWeek2", "TxtBx1Mnth", "TxtBx2Mnth", "TxtBx3Mnth", "TxtBx6Mnth", _
"TxtBx1Y", "TxtBx2Yr", "TxtBx3Yr", "TxtBx4Yr", "TxtBox5Yr", "TxtBx7Yr", "TxtBx10Yr", "TxtBx12Yr", _
"TxtBx25Yr", "TxtBxParentWk1", "TxtBxParentWk2", "TxtBxParent1Mnth", "TxtBxParent2Mnth", "TxtParent3Mnth", _
"TxtBxParent6Mnth", "TxtBxParent1Yr", "TxtBxParent2Yr", "TxtBxParent3Yr", "TxtBxParent4Yr", "TxtBxParent5Yr", _
"TxtBxParent7Yr", "TxtBxParent10Yr", "TxtBxParent12y", "TxtBxParent25Yr", "CmboBxTaskStatus", _
"TxtBxMaintenanceComments", "TxtBxGeneralComments")
End Function
'DON'T NEED TO CHECK AND ENTRY HAS BEEN MADE
Function IsComplete(ByVal FormControl As Object) As Boolean
Select Case TypeName(FormControl)
Case Is = "TextBox", "ComboBox"
With FormControl
If .Tag = "Required" And Len(.Text) = 0 Then
MsgBox "Required Field Please Enter Value", 48, "Required Entry"
.SetFocus
Exit Function
End If
End With
End Select
IsComplete = True
End Function
this is the code on the form
Dim Dataws As Worksheet
Dim TempRow As Long
Dim LastRow As Long
Private Sub ButtonAddUpdate_Click()
Dim WhichAction As XLActionType
Dim WhichRecordRow As Long
Select Case Me.ButtonAddUpdate.Caption
Case "Add"
LastRow = LastRow + 1
WhichAction = xlAdd
WhichRecordRow = LastRow
Case "Update"
WhichAction = xlUpdate
WhichRecordRow = Me.ScrollBar1.Value
End Select
FormData Form:=Me, sh:=Dataws, RecordRow:=WhichRecordRow, Action:=WhichAction
End Sub
Private Sub ButtonCancel_Click()
With Me.ScrollBar1
.Max = LastRow
.Value = TempRow
End With
FormData Form:=Me, sh:=Dataws, RecordRow:=Me.ScrollBar1.Value, Action:=xlScrollRow
End Sub
Private Sub ButtonDelete_Click()
Dim msg As Integer
msg = MsgBox("Do You Want To Delete Selected Record?", 36, "Delete Record")
If msg = 7 Then Exit Sub
FormData Form:=Me, sh:=Dataws, RecordRow:=Me.ScrollBar1.Value, Action:=xlDelete
LastRow = LastRow - 1
If LastRow = 1 Then LastRow = 2
Me.ScrollBar1.Max = LastRow
End Sub
Private Sub ButtonNew_Click()
With Me.ScrollBar1
TempRow = .Value
.Max = LastRow + 1
.Value = LastRow + 1
End With
FormData Form:=Me, sh:=Dataws, RecordRow:=Me.ScrollBar1.Value, Action:=xlNew
End Sub
Private Sub ScrollBar1_Change()
FormData Form:=Me, sh:=Dataws, RecordRow:=Me.ScrollBar1.Value, Action:=xlScrollRow
End Sub
Private Sub UserForm_Initialize()
CmboBxFailureMode.List = Array("Untimely operation", _
"Failure to operate when required", _
"Loss of output,Intermittent output", _
"Erroneous output", _
"Invalid output")
'worksheet that contains your data
'rename as required
'Set Dataws = ThisWorkbook.Worksheets("Data")
Set Dataws = ThisWorkbook.Worksheets("worksheet")
'worksheet that contains data is called worksheet renamed accordingly
LastRow = Dataws.Cells(Dataws.Rows.Count, 1).End(xlUp).Row
'assumes row 1 is header row
If LastRow = 1 Then LastRow = 2
With Me.ScrollBar1
.Min = 2
.Max = LastRow
.Value = 2
End With
End Sub
there are more than 40 textboxes and a couple of combo boxes only 11 of the text boxes show information and the first one updates to the date (todays) every time I update the information (the first text box should be the primary number for sorting the sheet).
I am using 2010 excel and windows 7
what I am trying to get:
a form to edit scroll update or delete information from an excel spread sheet
copy the information from cells I have updated scroll to the next line and past the information to the next line.
add a filter to one of the boxes much the same as filtering data on the spread sheet.
Notes:
there will only be a certain number of text boxes where data will be added most other information won't change.
many thanks if anyone can help
this is the code in the module
Enum XLActionType
xlNew
xlAdd
xlUpdate
xlScrollRow
xlDelete
End Enum
Sub FormData(ByVal Form As Object, ByVal sh As Object, ByVal RecordRow As Long, ByVal Action As XLActionType)
Dim i As Integer
Dim CalDate As Variant
Dim msg As String
Dim ctrl As msforms.Control
On Error GoTo ExitSub
With sh
'add password if required
.Unprotect Password:=""
Select Case Action
Case xlNew
EnableButtons Form:=Form, NewButton:=False, CancelButton:=True, DeleteButton:=False, AddUpdateButton:="Add"
'Form.Calendar.Value = Date
'THERE IS NO CALANDER ON THIS FORM
'clear form
For Each ctrl In Form.Controls
If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then ctrl.Value = ""
Next ctrl
Case xlAdd, xlUpdate
'validate required entry
For Each ctrl In Form.Controls
If Not IsComplete(ctrl) Then GoTo ExitSub
Next ctrl
'For i = 0 To 10 CHANGED THE NO FROM 10 TO 100
For i = 0 To 100
If i = 0 Then
.Cells(RecordRow, 1).Offset(0, i).Value = Form.Controls(ControlArray(i)).Value
Else
.Cells(RecordRow, 1).Offset(0, i).Value = Form.Controls(ControlArray(i)).Value
End If
Next
EnableButtons Form
msg = IIf(Action = xlAdd, "New Record Added To Database", "Record Updated")
MsgBox msg, 48, Left(msg, 16)
Case xlScrollRow
For i = 0 To 10
If i = 0 Then
CalDate = .Cells(RecordRow, 1).Offset(0, i).Value
CalDate = IIf(IsDate(CalDate), CDate(CalDate), Date)
Form.Controls(ControlArray(i)).Value = CalDate
Else
Form.Controls(ControlArray(i)).Value = .Cells(RecordRow, 1).Offset(0, i).Value
End If
Next i
EnableButtons Form
Case xlDelete
Application.EnableEvents = False
.Cells(RecordRow, 1).EntireRow.Delete xlShiftUp
MsgBox "Record Deleted", 48, "Record Deleted"
End Select
'add password if required
'.Protect Password:=""
End With
ExitSub:
Application.EnableEvents = True
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub
Sub EnableButtons(ByVal Form As Object, Optional ByVal NewButton As Boolean = True, Optional ByVal CancelButton As Boolean, _
Optional ByVal DeleteButton As Boolean = True, Optional ByVal AddUpdateButton As String = "Update")
With Form
.ButtonCancel.Enabled = CancelButton
.ButtonNew.Enabled = NewButton
.ButtonDelete.Enabled = DeleteButton
.ButtonAddUpdate.Caption = AddUpdateButton
End With
End Sub
Function ControlArray() As Variant
'ORIGINAL CODING PROBABLY DELET WHEN FINISHED
'ControlArray = Array("Calendar", "TxtBxInfo", "CmboBxSite", _
'"CmboBxProjTitle", "CmboBxJob", "CmboBxServiceObj", _
'"CmboBxObjectives", "CmboBxActionSteps", "CmboBxExpPerform", _
'"CmboBxExceedPer", "TxtBxSupportDoc")
'DELETE OBOVE WHEN FINISHED
ControlArray = Array("TxtBxPrimaryNo", "TxtBxModule", "TxtBxParentFler", _
"TxtbxFler", "TxtBxFlerDescription", "TxtBxAssetclass", "TxtBxCommdate", "TxtBxAssetRepVal", _
"TxtBxReliability", "TxtBxPerformance", "TxtBxExternalCondition", "TxtBxObsolescence", _
"TxtBxOverallCondition", "CmboBxFailuremode", "TxtBxFailureEffects", "TxtBxMTBF", "TxtBxAvgMainCost", _
"TxtBxProductionLossHrs", "TxtBxSafManHrs", "TxtBxRiskYear", "TxtBxUnplannedActual", _
"TxtBxPlannedActual", "TxtBxWk1", "TxtBxWeek2", "TxtBx1Mnth", "TxtBx2Mnth", "TxtBx3Mnth", "TxtBx6Mnth", _
"TxtBx1Y", "TxtBx2Yr", "TxtBx3Yr", "TxtBx4Yr", "TxtBox5Yr", "TxtBx7Yr", "TxtBx10Yr", "TxtBx12Yr", _
"TxtBx25Yr", "TxtBxParentWk1", "TxtBxParentWk2", "TxtBxParent1Mnth", "TxtBxParent2Mnth", "TxtParent3Mnth", _
"TxtBxParent6Mnth", "TxtBxParent1Yr", "TxtBxParent2Yr", "TxtBxParent3Yr", "TxtBxParent4Yr", "TxtBxParent5Yr", _
"TxtBxParent7Yr", "TxtBxParent10Yr", "TxtBxParent12y", "TxtBxParent25Yr", "CmboBxTaskStatus", _
"TxtBxMaintenanceComments", "TxtBxGeneralComments")
End Function
'DON'T NEED TO CHECK AND ENTRY HAS BEEN MADE
Function IsComplete(ByVal FormControl As Object) As Boolean
Select Case TypeName(FormControl)
Case Is = "TextBox", "ComboBox"
With FormControl
If .Tag = "Required" And Len(.Text) = 0 Then
MsgBox "Required Field Please Enter Value", 48, "Required Entry"
.SetFocus
Exit Function
End If
End With
End Select
IsComplete = True
End Function
this is the code on the form
Dim Dataws As Worksheet
Dim TempRow As Long
Dim LastRow As Long
Private Sub ButtonAddUpdate_Click()
Dim WhichAction As XLActionType
Dim WhichRecordRow As Long
Select Case Me.ButtonAddUpdate.Caption
Case "Add"
LastRow = LastRow + 1
WhichAction = xlAdd
WhichRecordRow = LastRow
Case "Update"
WhichAction = xlUpdate
WhichRecordRow = Me.ScrollBar1.Value
End Select
FormData Form:=Me, sh:=Dataws, RecordRow:=WhichRecordRow, Action:=WhichAction
End Sub
Private Sub ButtonCancel_Click()
With Me.ScrollBar1
.Max = LastRow
.Value = TempRow
End With
FormData Form:=Me, sh:=Dataws, RecordRow:=Me.ScrollBar1.Value, Action:=xlScrollRow
End Sub
Private Sub ButtonDelete_Click()
Dim msg As Integer
msg = MsgBox("Do You Want To Delete Selected Record?", 36, "Delete Record")
If msg = 7 Then Exit Sub
FormData Form:=Me, sh:=Dataws, RecordRow:=Me.ScrollBar1.Value, Action:=xlDelete
LastRow = LastRow - 1
If LastRow = 1 Then LastRow = 2
Me.ScrollBar1.Max = LastRow
End Sub
Private Sub ButtonNew_Click()
With Me.ScrollBar1
TempRow = .Value
.Max = LastRow + 1
.Value = LastRow + 1
End With
FormData Form:=Me, sh:=Dataws, RecordRow:=Me.ScrollBar1.Value, Action:=xlNew
End Sub
Private Sub ScrollBar1_Change()
FormData Form:=Me, sh:=Dataws, RecordRow:=Me.ScrollBar1.Value, Action:=xlScrollRow
End Sub
Private Sub UserForm_Initialize()
CmboBxFailureMode.List = Array("Untimely operation", _
"Failure to operate when required", _
"Loss of output,Intermittent output", _
"Erroneous output", _
"Invalid output")
'worksheet that contains your data
'rename as required
'Set Dataws = ThisWorkbook.Worksheets("Data")
Set Dataws = ThisWorkbook.Worksheets("worksheet")
'worksheet that contains data is called worksheet renamed accordingly
LastRow = Dataws.Cells(Dataws.Rows.Count, 1).End(xlUp).Row
'assumes row 1 is header row
If LastRow = 1 Then LastRow = 2
With Me.ScrollBar1
.Min = 2
.Max = LastRow
.Value = 2
End With
End Sub
