Hello,
In the worksheet there are 11 textboxes. If for some reason I accidentally press the "reset" button and I want to undo them. Can you someone please tell me or what vba code I need. Thank you.
The userform I have call is "frmInputs" plust the 11 textboxes.
Here is the code I have so far.
Dim a, b
Private Sub cmdReset_Click()
For Each ctl In Controls
If TypeName(ctl) = "TextBox" Then ctl.Text = vbNullString
Next
a = UniqueArrayByDict([Agency].Value, 1)
a = advArrayListSort(a)
With ListBox1
.List = a
.ListIndex = 0
End With
'TextBox1.BackColor = 16777215
End Sub
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)
With ListBox1
.List = a
.ListIndex = -1
End With
End Sub
Private Sub TextBox1_Change()
'Ken, added:
Dim s As String, b
If Me.TextBox1.Value = "" Then
Me.TextBox1.BackColor = &HFFFF&: Exit Sub
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 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
code in module1:
Option Explicit
Function UniqueArrayByDict(Array1d As Variant, Optional compareMethod As Integer = 0) As Variant
Dim dic As Object 'Late Binding method - Requires no Reference
Set dic = CreateObject("Scripting.Dictionary") 'Late or Early Binding method
Dim e As Variant
dic.CompareMode = compareMethod
For Each e In Array1d
If e <> vbNullString Then
If Not dic.Exists(e) Then dic.Add e, Nothing
End If
Next e
UniqueArrayByDict = dic.Keys
End Function
Function advArrayListSort(sn As Variant, Optional tfAscending1 As Boolean = True, _
Optional tfAscending2 As Boolean = True, _
Optional tfNumbersFirst As Boolean = True) As Variant
Dim i As Long, c1 As Object, c2 As Object
Dim a1() As Variant, a2() As Variant, a() As Variant
Set c1 = CreateObject("System.Collections.ArrayList")
Set c2 = CreateObject("System.Collections.ArrayList")
For i = LBound(sn) To UBound(sn)
If IsNumeric(sn(i)) = True Then
c1.Add sn(i)
Else
c2.Add sn(i)
End If
Next i
c1.Sort 'Sort ascendending
c2.Sort 'Sort ascending
If tfAscending1 = False Then c1.Reverse 'Sort and then Reverse to sort descending
If tfAscending2 = False Then c2.Reverse 'Sort and then Reverse to sort descending
a1() = c1.Toarray()
a2() = c2.Toarray()
If tfNumbersFirst = True Then
a() = a1()
For i = 1 To c2.Count
ReDim Preserve a(UBound(a) + 1)
a(UBound(a)) = a2(i - 1)
Next i
Else
a() = a2()
For i = 1 To c1.Count
ReDim Preserve a(UBound(a) + 1)
a(UBound(a)) = a1(i - 1)
Next i
End If
advArrayListSort = a()
End Function
module2:
Public tmpheader, tmpmysht, tmpfmen, tmpwken, tmpcben
Sub printMySheet1()
Sheets("Sheet1").PrintOut
End Sub
Sub callfrmInputs()
'Load frmInputs
frmInputs.Show
End Sub
Bookmarks