Two Issues: clearing incorrect value from userform and spreadsheet and clear last row of information pasted

K

KayWill

New Member
Joined
Jan 22, 2015
Messages
36
Hello, I have been trying to work on a solution for a week and a come close but no cigar. I have a user form that the user enter's in their %'s for specific fields. Not all textboxes will have a %. What I'm trying to do is not allow the sum of all textboxes to exceed 100%, if it does, all textboxes are set to null & the user has to reenter. The problem is, bad data is still pasting to the spreadsheet so I thought I could clear the table that the information is being entered into. The problem is more than the last row on the table is being deleted and incorrect values are being placed in the textboxes. Below is my code, if anyone can direct me where I'm screwing up it will be greatly appreciated:
Code: 
    Dim cCont As Control
    Dim sEntries As String
    Dim oLst As ListObject

On Error Resume Next

' Write data to worksheet
  Set ws = Worksheets("CoreConSummary")
  LRow = ws.Cells(Rows.Count, 34).End(xlUp).Offset(0, 34).Row + 1
    
    With ws
        .Cells(LRow, 34).Value = Me.txt_SiteWrk.Value
        .Cells(LRow, 35).Value = Me.txt_VESTIBULE.Value
        .Cells(LRow, 36).Value = Me.txt_CHKOUT.Value
        .Cells(LRow, 37).Value = Me.txt_PHOTOLAB.Value
        .Cells(LRow, 38).Value = Me.txt_MINCLINIC.Value
        .Cells(LRow, 39).Value = Me.txt_RETAIL.Value
        .Cells(LRow, 40).Value = Me.txt_SOA.Value
        .Cells(LRow, 41).Value = Me.txt_PHARMACY.Value
        .Cells(LRow, 42).Value = Me.txt_EMPAREA.Value
        .Cells(LRow, 43).Value = Me.txt_RECVAREA.Value
        .Cells(LRow, 44).Value = Me.txt_RRMS.Value
        .Cells(LRow, 45).Value = Me.txt_GENCOND.Value
        .Cells(LRow, 46).Value = Me.txt_PROFIT.Value
        .Cells(LRow, 47).Value = Format(Now, "mm/dd/yyyy hh:nn:ss")
    End With

    ' Check that sum does not exceed 100%
    For Each cCont In UserInput.Controls
        If TypeOf cCont Is MSForms.TextBox Then _
          sEntries = Val(txt_SiteWrk.Value) + Val(txt_VESTIBULE.Value) + Val(txt_CHKOUT.Value) + Val(txt_PHOTOLAB.Value) + Val(txt_MINCLINIC.Value) + Val(txt_RETAIL.Value) + Val(txt_SOA.Value) + Val(txt_PHARMACY.Value) + Val(txt_EMPAREA.Value) + Val(txt_RECVAREA.Value) + Val(txt_RRMS.Value) + Val(txt_GENCOND.Value) + Val(txt_PROFIT.Value) & CStr(cCont)
    
    If Trim(sEntries) < 100 And Trim(sEntries) > 100 Then _
      sEntries = False
        MsgBox "Total percentage can not be less than OR exceed 100%, please check your entries and update", vbOKOnly + vbCritical, "ERROR!"
        txt_SiteWrk = ""
        txt_VESTIBULE = ""
        txt_CHKOUT = ""
        txt_PHOTOLAB = ""
        txt_MINCLINIC = ""
        txt_RETAIL = ""
        txt_SOA = ""
        txt_PHARMACY = ""
        txt_EMPAREA = ""
        txt_RECVAREA = ""
        txt_RRMS = ""
        txt_GENCOND = ""
        txt_PROFIT = ""
        
'Clear table on spreadsheet to reapply correct %
  
 Application.ScreenUpdating = False
  
If ActiveSheet.ListObjects.Count > 1 Then
     For Each oLst In ActiveSheet.ListObjects
         With oLst
             If .Name = "PERCENTAPP" Then
                 If oLst.ListRows.Count > 1 Then
             oLst.ListRows(oLst.ListRows.Count).Delete
         End If
       End If
     End With
     Next
End If
 
Next
 txt_SiteWrk.SetFocus
    

   
' Clear the form
    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            ctl.Value = ""
        ElseIf TypeName(ctl) = "CheckBox" Then
            ctl.Value = False
    End If
    Next ctl
  
End Sub

Again, any help will be greatly appreciated.
 
Sort by date Sort by votes
Hi,
You appear to have your code in wrong order. You are adding record to your sheet and then doing the test for invalid results. If you apply the test first & prevent invalid entries from being added to sheet you would negate need to delete them.

Not tested but see if this updated code helps you:

Place in your forms code page:
Code: 
 Private Sub CommandButton1_Click()    
   Dim Lrow As Long
    Dim i As Integer, c As Long
    Dim Total As Double


    On Error GoTo myerror


    'check totals = 100%
    If IsHundredPercent(Form:=Me, Total:=Total) Then
        ' Write data to worksheet
        Set ws = Worksheets("CoreConSummary")
        Lrow = ws.Cells(ws.Rows.Count, 34).End(xlUp).Offset(0, 34).Row + 1


        c = 34


        For i = LBound(ControlsArray) To UBound(ControlsArray)
            ws.Cells(Lrow, c).Value = Val(Me.Controls(ControlsArray(i)).Text)
            c = c + 1
        Next i
        ws.Cells(Lrow, 47).Value = Format(Now, "mm/dd/yyyy hh:nn:ss")


        ClearForm Form:=Me


    Else


        MsgBox "Total:= " & Total & Chr(10) & _
        "Percentage can not be less than OR exceed 100%" & Chr(10) & _
               "Please check your entries and update.", 16, "ERROR!"




    End If
    
myerror:
        If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Place this code in standard module.
Code: 
 Function ControlsArray() As Variant    ControlsArray = Array("txt_SiteWrk", "txt_VESTIBULE", "txt_CHKOUT", "txt_PHOTOLAB", "txt_MINCLINIC", _
                          "txt_RETAIL", "txt_SOA", "txt_PHARMACY", "txt_EMPAREA", "txt_RECVAREA", _
                          "txt_RRMS", "txt_GENCOND", "txt_PROFIT")
End Function


Function IsHundredPercent(ByVal Form As Object, ByRef Total As Double) As Boolean
    Dim Entry As Double
    Dim i As Integer
    For i = LBound(ControlsArray) To UBound(ControlsArray)
        With Form.Controls(ControlsArray(i))
            If IsNumeric(.Value) Then Entry = Entry + Val(.Value)
        End With
    Next i
    IsHundredPercent = Entry = 100
    Total = Entry


End Function


Sub ClearForm(ByVal Form As Object)
    Dim ctl As Object
    ' Clear the form
    For Each ctl In Form.Controls
        Select Case TypeName(ctl)
            Case "TextBox", "ComboBox"
                ctl.Value = ""
            Case "CheckBox", "OptionButton"
                ctl.Value = False
        End Select
    Next ctl
End Sub

Updated code includes function to check total of all values entered = 100.

You will note that I have not cleared form if values entered do not = 100% - it is more helpful to users if they can study values they have entered to correct errors.
but you should adjust code as required to meet your project need.

Hope Helpful

Dave
 
Upvote 0
dmt32 said:
Hi,
You appear to have your code in wrong order. You are adding record to your sheet and then doing the test for invalid results. If you apply the test first & prevent invalid entries from being added to sheet you would negate need to delete them.

Not tested but see if this updated code helps you:

Place in your forms code page:
Code: 
 Private Sub CommandButton1_Click()    
   Dim Lrow As Long
    Dim i As Integer, c As Long
    Dim Total As Double


    On Error GoTo myerror


    'check totals = 100%
    If IsHundredPercent(Form:=Me, Total:=Total) Then
        ' Write data to worksheet
        Set ws = Worksheets("CoreConSummary")
        Lrow = ws.Cells(ws.Rows.Count, 34).End(xlUp).Offset(0, 34).Row + 1


        c = 34


        For i = LBound(ControlsArray) To UBound(ControlsArray)
            ws.Cells(Lrow, c).Value = Val(Me.Controls(ControlsArray(i)).Text)
            c = c + 1
        Next i
        ws.Cells(Lrow, 47).Value = Format(Now, "mm/dd/yyyy hh:nn:ss")


        ClearForm Form:=Me


    Else


        MsgBox "Total:= " & Total & Chr(10) & _
        "Percentage can not be less than OR exceed 100%" & Chr(10) & _
               "Please check your entries and update.", 16, "ERROR!"




    End If
    
myerror:
        If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Place this code in standard module.
Code: 
 Function ControlsArray() As Variant    ControlsArray = Array("txt_SiteWrk", "txt_VESTIBULE", "txt_CHKOUT", "txt_PHOTOLAB", "txt_MINCLINIC", _
                          "txt_RETAIL", "txt_SOA", "txt_PHARMACY", "txt_EMPAREA", "txt_RECVAREA", _
                          "txt_RRMS", "txt_GENCOND", "txt_PROFIT")
End Function


Function IsHundredPercent(ByVal Form As Object, ByRef Total As Double) As Boolean
    Dim Entry As Double
    Dim i As Integer
    For i = LBound(ControlsArray) To UBound(ControlsArray)
        With Form.Controls(ControlsArray(i))
            If IsNumeric(.Value) Then Entry = Entry + Val(.Value)
        End With
    Next i
    IsHundredPercent = Entry = 100
    Total = Entry


End Function


Sub ClearForm(ByVal Form As Object)
    Dim ctl As Object
    ' Clear the form
    For Each ctl In Form.Controls
        Select Case TypeName(ctl)
            Case "TextBox", "ComboBox"
                ctl.Value = ""
            Case "CheckBox", "OptionButton"
                ctl.Value = False
        End Select
    Next ctl
End Sub

Updated code includes function to check total of all values entered = 100.

You will note that I have not cleared form if values entered do not = 100% - it is more helpful to users if they can study values they have entered to correct errors.
but you should adjust code as required to meet your project need.

Hope Helpful

Dave
Click to expand...

Thank you Dave, I figured I had my code backwards but just couldn't get it correct. I will try your response above and reply back to let you know the results.
 
Upvote 0
Hi Dave, sorry for the delay, been a hectic week with school letting out and additional projects. I was able to place your code in my spreadsheet but when the user enters an amount that is greater than or less than 100%, it does great to not paste and provides the warning. But when it goes back to the form, the values are not cleared out and when I try to change an entered value to the correct value it gives me
Run-time error '13' type mismatch
Click to expand...

When I go to the debug, it takes me to here:
Code: 
Private Sub txt_CHKOUT_AfterUpdate()
txt_CHKOUT.Value = Format(txt_CHKOUT.Value / 100, "0.0%")
End Sub
this was working fine before. I'm going to paste my entire code to the userform; sorry I didn't do this sooner.
Code: 
Option Explicit
Public ctl As Control
Public RowCount As Long
Public sht As Worksheet
Public LastRow As Long
Public ws As Worksheet
Public Lrow As Long
Public rw As Range

Private Sub UserInput_Initialize()
  
 txt_SiteWrk.SetFocus
 

End Sub

Private Sub txt_SiteWrk_AfterUpdate()
txt_SiteWrk.Value = Format(txt_SiteWrk.Value / 100, "0.0%")
End Sub
Private Sub txt_VESTIBULE_AfterUpdate()
txt_VESTIBULE.Value = Format(txt_VESTIBULE.Value / 100, "0.0%")
End Sub
Private Sub txt_CHKOUT_AfterUpdate()
txt_CHKOUT.Value = Format(txt_CHKOUT.Value / 100, "0.0%")
End Sub
Private Sub txt_PHOTOLAB_AfterUpdate()
txt_PHOTOLAB.Value = Format(txt_PHOTOLAB.Value / 100, "0.0%")
End Sub
Private Sub txt_MINCLINIC_AfterUpdate()
txt_MINCLINIC.Value = Format(txt_MINCLINIC.Value / 100, "0.0%")
End Sub
Private Sub txt_RETAIL_AfterUpdate()
txt_RETAIL.Value = Format(txt_RETAIL.Value / 100, "0.0%")
End Sub
Private Sub txt_SOA_AfterUpdate()
txt_SOA.Value = Format(txt_SOA.Value / 100, "0.0%")
End Sub
Private Sub txt_PHARMACY_AfterUpdate()
txt_PHARMACY.Value = Format(txt_PHARMACY.Value / 100, "0.0%")
End Sub
Private Sub txt_EMPAREA_AfterUpdate()
txt_EMPAREA.Value = Format(txt_EMPAREA.Value / 100, "0.0%")
End Sub

Private Sub txt_RECVAREA_AfterUpdate()
txt_RECVAREA.Value = Format(txt_RECVAREA.Value / 100, "0.0%")
End Sub

Private Sub txt_RRMS_AfterUpdate()
txt_RRMS.Value = Format(txt_RRMS.Value / 100, "0.0%")
End Sub
Private Sub txt_GENCOND_AfterUpdate()
txt_GENCOND.Value = Format(txt_GENCOND.Value / 100, "0.0%")
End Sub
Private Sub txt_PROFIT_AfterUpdate()
txt_PROFIT.Value = Format(txt_PROFIT.Value / 100, "0.0%")
End Sub


Private Sub CommandButton1_Click()
' Clear the form
    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            ctl.Value = ""
    End If
    Next ctl
End Sub

Private Sub CommandButton2_Click()
  Dim Lrow As Long
  Dim i As Integer, c As Long
  Dim Total As Double


    On Error GoTo myerror


    'check totals = 100%
    If IsHundredPercent(Form:=Me, Total:=Total) Then
        ' Write data to worksheet
        Set ws = Worksheets("CoreConSummary")
        Lrow = ws.Cells(ws.Rows.Count, 34).End(xlUp).Offset(0, 34).Row + 1


        c = 34


        For i = LBound(ControlsArray) To UBound(ControlsArray)
            ws.Cells(Lrow, c).Value = Val(Me.Controls(ControlsArray(i)).Text)
            c = c + 1
        Next i
        ws.Cells(Lrow, 47).Value = Format(Now, "mm/dd/yyyy hh:nn:ss")


        ClearForm Form:=Me


    Else


        MsgBox "Total:= " & Total & Chr(10) & _
        "Percentage can not be less than OR exceed 100%" & Chr(10) & _
               "Please check your entries and update.", 16, "ERROR!"




    End If
    
myerror:
        If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Private Sub CommandButton3_Click()
Dim mbResult As Integer
mbResult = MsgBox("You are exiting the data entry form; please click 'OK' to continue working in spreadsheet?", _
 vbOKOnly + vbExclamation, "You are now exiting the entry form.")

Select Case mbResult
    Case vbOK
        'Modify as needed, this is a simple example with no error handling:
        Unload Me
        If Workbooks.Count = 1 Then
        ThisWorkbook.Save
        Else
        UserInput.Hide
        End If

    Case vbNo
        ' Do nothing and allow the macro to run

    Case vbCancel
        ' Do NOT allow the macro to run
        Exit Sub

End Select
'CLOSE FORM AND SAVE
 Unload Me
        If Workbooks.Count = 1 Then
        ThisWorkbook.Save
        Else
        UserInput.Hide
    End If
End Sub
 
Upvote 0
Re: Two (RESOLVED) Issues: clearing incorrect value from userform and spreadsheet and clear last row of info pasted

Thank you, THANK YOU DAVE!:pray:

I took another look and edited the formula you provided and it works perfectly now, THANKS for all your help! For reference, see code below:

Placed in my userform (added info in red):
Code: 
Private Sub CommandButton2_Click()
  Dim Lrow As Long
  Dim i As Integer, c As Long
  Dim Total As Double


    On Error GoTo myerror


    'check totals = 100%
    If IsHundredPercent(Form:=Me, Total:=Total) Then
        ' Write data to worksheet
        Set ws = Worksheets("CoreConSummary")
        Lrow = ws.Cells(ws.Rows.Count, 34).End(xlUp).Offset(0, 34).Row + 1


        c = 34


        For i = LBound(ControlsArray) To UBound(ControlsArray)
            ws.Cells(Lrow, c).Value = Val(Me.Controls(ControlsArray(i)).Text)
            c = c + 1
        Next i
        ws.Cells(Lrow, 47).Value = Format(Now, "mm/dd/yyyy hh:nn:ss")


        ClearForm Form:=Me


    Else


        MsgBox "Total:= " & Total & Chr(10) & _
        "Percentage can not be less than OR exceed 100%" & Chr(10) & _
               "Please check your entries and update.", 16, "ERROR!"


        [COLOR="#B22222"]ClearForm Form:=Me[/COLOR]

    End If
    
myerror:
        If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

and edited following function in standard module (edits in red):
Code: 
Function ControlsArray() As Variant
ControlsArray = Array("txt_SiteWrk", "txt_VESTIBULE", "txt_CHKOUT", "txt_PHOTOLAB", "txt_MINCLINIC", _
                          "txt_RETAIL", "txt_SOA", "txt_PHARMACY", "txt_EMPAREA", "txt_RECVAREA", _
                          "txt_RRMS", "txt_GENCOND", "txt_PROFIT")
End Function


Function IsHundredPercent(ByVal Form As Object, ByRef Total As Double) As Boolean
    Dim Entry As Double
    Dim i As Integer
    For i = LBound(ControlsArray) To UBound(ControlsArray)
        With Form.Controls(ControlsArray(i))
            If IsNumeric(.Value) Then Entry = Entry + [COLOR="#B22222"](Val(.Value) / 100)[/COLOR]        End With
    Next i
    IsHundredPercent = Entry = [COLOR="#B22222"]1[/COLOR]    Total = Entry


End Function
 
Upvote 0
Re: Two (RESOLVED) Issues: clearing incorrect value from userform and spreadsheet and clear last row of info pasted

Hi,
would have been helpful if had posted all your forms code in first instance but no worries if you have adapted solution & it is now working ok for you that’s what really matters.


many thanks for feedback very much appreciated.

Dave:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Page break issues when exporting to pdf from userform (VBA)
Replies
0
Views
921
auglocqnuk
A
K
  • Question Question
Want to concatenate 10 TextBox.Values from a userform in an excel cell-specific column
Replies
1
Views
2K
KayWill
K
K
  • Question Question
VBA Excel 2010 User Form Money Calculator Issues
Replies
0
Views
1K
killiouta
K
R
  • Question Question
Merge “Paste Values only” VBA code with “force macros” VBA code and place the code into ThisWorkbook
Replies
1
Views
3K
VoG
VoG

Share this page

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