Hello Everyone,
My project has 12 textboxes and 1 Listbox<o></o>
<o></o>The CLEARBUTTON in the userform is not working. After Iclick “OK” and start a brand new then I click “CLEARBUTTON” then I received this Runtime error 13.
Please tell me what I need to do.
Here is the vba code:
Option Compare Text
Const header = "C12,a ,k22,a ,o22,a ,n23,a ,v23,a ,n24,a ,v24,a ,n25,a ,x25,a ,e30,a ,e31,a ,d44,a"
Const Secflr = " Address Incomplete.| Appearance date on the citation is not readable.| " & _
""
Const mySheet = "Sheet1"
Dim a, b
Private Sub UserForm_Initialize()
If tmpfmen = "" And tmpwken = "" Then
CmdUndo.Enabled = False
Else
CmdUndo.Enabled = True
End If
Me.Textbox10.RowSource = "Reason!A1:A" & Sheets("Reason").Range("A" & Rows.Count).End(xlUp).Row
a = UniqueArrayByDict([Agency].Value, 1)
a = advArrayListSort(a)
ListBox1.List = a
End Sub
Private Sub TextBox1_Change()
Dim s As String, b
If Me.TextBox1.Value = "" Then
Me.TextBox1.BackColor = &HFFFF&
Else
TextBox1.BackColor = 16777215
End If
TextBox1.Value = UCase(TextBox1.Value)
s = TextBox1.Value
If Not IsArray(b) Then b = a
b = Filter(b, s) 'case sensitive
b = Filter(b, s, True, vbTextCompare) 'case insensitive
ListBox1.List = b
End Sub
Private Sub CmdClearEntry_Click()
Dim ct As Control
tmpfmen = ""
tmpcben = ""
For Each ct In Me.Controls
If InStr(ct.Name, "TextBox") > 0 Then
tmpfmen = tmpfmen & ct & "|"
ct = ""
ElseIf InStr(ct.Name, "Textbox") > 0 Then
tmpcben = tmpcben & ct & "|"
ct = ""
End If
Next
tmpfmen = Left(tmpfmen, Len(tmpfmen) - 1)
tmpcben = Left(tmpcben, Len(tmpcben) - 1)
tmpheader = header
tmpmysht = mySheet
headerArr = Split(header, ",")
tmpwken = ""
Set sht = Worksheets(mySheet)
For a = 0 To (UBound(headerArr) - 1) / 2
tmpwken = tmpwken & sht.Range(headerArr(a * 2)) & "|"
sht.Range(headerArr(a * 2)) = ""
Next
tmpwken = Left(tmpwken, Len(tmpwken) - 1)
CmdUndo.Enabled = True
End Sub
Private Sub CmdUndo_Click()
fmen = Split(tmpfmen, "|")
cben = Split(tmpcben, "|")
Dim ctl As Control
For Each ctl In Me.Controls
If InStr(ctl.Name, "TextBox") Then
ctl.Text = fmen
n = n + 1
ElseIf InStr(ctl.Name, "Textbox") Then
ctl.Text = cben(m)
m = m + 1
End If
Next
headre = tmpheader
mySheet1 = tmpmysht
headerArr = Split(headre, ",")
wken = Split(tmpwken, "|")
Set sht = Worksheets(mySheet1)
For a = 0 To (UBound(headerArr) - 1) / 2
sht.Range(headerArr(a * 2)) = wken(n2)
n2 = n2 + 1
Next
CmdUndo.Enabled = False
tmpfmen = ""
tmpcben = ""
tmpwken = ""
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Value = ListBox1.Value
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Sub CmdExit_Click()
ThisWorkbook.Saved = True
'ThisWorkbook.Close
Unload Me
End Sub
Private Sub CommandButton1_Click()
If UBound(headerArr) Mod 2 <> 1 Then MsgBox "Error in Cell Address & Header pair"
For a = 0 To (UBound(headerArr) - 1) / 2
Range(headerArr(a * 2)).Offset(0, 1) = InputBox(headerArr(a * 2 + 1), "Field Entry")
Next
End Sub
Private Sub cmdOK_Click()
headerArr = Split(header, ",")
Set sht = Worksheets(mySheet)
For a = 0 To (UBound(headerArr) - 1) / 2
sht.Range(headerArr(a * 2)) = Controls("TextBox" & (a + 1))
Sheet1.[C12].Value = ListBox1.Value
Next
End Sub
Private Sub cmdPrint_Click()
ActiveSheet.PrintOut copies:=1
End Sub
Private Sub TextBox1_Enter()
Me.TextBox1.BackColor = &HFFFF&
Me.TextBox1.Value = ""
Sheets("Agency").Range("IV:IV").ClearContents
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox1.BackColor = 16777215
End Sub
My project has 12 textboxes and 1 Listbox<o></o>
<o></o>The CLEARBUTTON in the userform is not working. After Iclick “OK” and start a brand new then I click “CLEARBUTTON” then I received this Runtime error 13.
Please tell me what I need to do.
Here is the vba code:
Option Compare Text
Const header = "C12,a ,k22,a ,o22,a ,n23,a ,v23,a ,n24,a ,v24,a ,n25,a ,x25,a ,e30,a ,e31,a ,d44,a"
Const Secflr = " Address Incomplete.| Appearance date on the citation is not readable.| " & _
""
Const mySheet = "Sheet1"
Dim a, b
Private Sub UserForm_Initialize()
If tmpfmen = "" And tmpwken = "" Then
CmdUndo.Enabled = False
Else
CmdUndo.Enabled = True
End If
Me.Textbox10.RowSource = "Reason!A1:A" & Sheets("Reason").Range("A" & Rows.Count).End(xlUp).Row
a = UniqueArrayByDict([Agency].Value, 1)
a = advArrayListSort(a)
ListBox1.List = a
End Sub
Private Sub TextBox1_Change()
Dim s As String, b
If Me.TextBox1.Value = "" Then
Me.TextBox1.BackColor = &HFFFF&
Else
TextBox1.BackColor = 16777215
End If
TextBox1.Value = UCase(TextBox1.Value)
s = TextBox1.Value
If Not IsArray(b) Then b = a
b = Filter(b, s) 'case sensitive
b = Filter(b, s, True, vbTextCompare) 'case insensitive
ListBox1.List = b
End Sub
Private Sub CmdClearEntry_Click()
Dim ct As Control
tmpfmen = ""
tmpcben = ""
For Each ct In Me.Controls
If InStr(ct.Name, "TextBox") > 0 Then
tmpfmen = tmpfmen & ct & "|"
ct = ""
ElseIf InStr(ct.Name, "Textbox") > 0 Then
tmpcben = tmpcben & ct & "|"
ct = ""
End If
Next
tmpfmen = Left(tmpfmen, Len(tmpfmen) - 1)
tmpcben = Left(tmpcben, Len(tmpcben) - 1)
tmpheader = header
tmpmysht = mySheet
headerArr = Split(header, ",")
tmpwken = ""
Set sht = Worksheets(mySheet)
For a = 0 To (UBound(headerArr) - 1) / 2
tmpwken = tmpwken & sht.Range(headerArr(a * 2)) & "|"
sht.Range(headerArr(a * 2)) = ""
Next
tmpwken = Left(tmpwken, Len(tmpwken) - 1)
CmdUndo.Enabled = True
End Sub
Private Sub CmdUndo_Click()
fmen = Split(tmpfmen, "|")
cben = Split(tmpcben, "|")
Dim ctl As Control
For Each ctl In Me.Controls
If InStr(ctl.Name, "TextBox") Then
ctl.Text = fmen
n = n + 1
ElseIf InStr(ctl.Name, "Textbox") Then
ctl.Text = cben(m)
m = m + 1
End If
Next
headre = tmpheader
mySheet1 = tmpmysht
headerArr = Split(headre, ",")
wken = Split(tmpwken, "|")
Set sht = Worksheets(mySheet1)
For a = 0 To (UBound(headerArr) - 1) / 2
sht.Range(headerArr(a * 2)) = wken(n2)
n2 = n2 + 1
Next
CmdUndo.Enabled = False
tmpfmen = ""
tmpcben = ""
tmpwken = ""
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Value = ListBox1.Value
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Sub CmdExit_Click()
ThisWorkbook.Saved = True
'ThisWorkbook.Close
Unload Me
End Sub
Private Sub CommandButton1_Click()
If UBound(headerArr) Mod 2 <> 1 Then MsgBox "Error in Cell Address & Header pair"
For a = 0 To (UBound(headerArr) - 1) / 2
Range(headerArr(a * 2)).Offset(0, 1) = InputBox(headerArr(a * 2 + 1), "Field Entry")
Next
End Sub
Private Sub cmdOK_Click()
headerArr = Split(header, ",")
Set sht = Worksheets(mySheet)
For a = 0 To (UBound(headerArr) - 1) / 2
sht.Range(headerArr(a * 2)) = Controls("TextBox" & (a + 1))
Sheet1.[C12].Value = ListBox1.Value
Next
End Sub
Private Sub cmdPrint_Click()
ActiveSheet.PrintOut copies:=1
End Sub
Private Sub TextBox1_Enter()
Me.TextBox1.BackColor = &HFFFF&
Me.TextBox1.Value = ""
Sheets("Agency").Range("IV:IV").ClearContents
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox1.BackColor = 16777215
End Sub
Last edited: