KjBox OzMVP  Super Moderator
 Male
 from Kuching, Borneo
 Member since Jan 10th 2007
 Last Activity:
 Forum HIRE HELP
 Posts
 4,390
 Likes Received
 48
 Points
 13,344
 Trophies
 1
 Profile Hits
 2,649

please help me to correct this code
Search: when i write in TEXTBOX (uppercase, lowercase or Numbers) wherever it's position in the word & list the find words in TEXTLIST (VBAUSERFORM)
the problem i should write the letter same as uppercase or lowercase in TEXTBOX to find it in the search otherwise if it not same letter characters are capital letters will not appear, & i would like to find the search result if the letters uppercase, lowercase or Numbers by change the wildcard ("*")
For Each C In Range("A2:A" & ss)
If C Like TextBox27.Value & "*" Then
\\\\\\\\\\\
Private Sub TextBox27_Change()
ListBox1.Clear
For i = 1 To 26
Controls("TextBox" & i).Text = ""
Next i
If TextBox27 = "" Then Exit Sub
Sheets(1).Activate
ss = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
k = 0
For Each C In Range("A2:A" & ss)
If C Like TextBox27.Value & "*" Then
ListBox1.AddItem
ListBox1.List(k, 0) = Cells(C.Row, 1).Value
ListBox1.List(k, 1) = C.Row
k = k + 1
End If
Next C
End Sub

Hi Charles I hope you are keeping well, and safe from covid19. !!!
Next Tuesday I am getting surgery on both of my eyes to correct some vision problems, Soooooo I am staying home from any of the possible germ bags (Carriers) out there.
Funny how the Mayan calendar predicted a pandemic in 2020.
Keep well everybody
Peter ( Potholes)

Hi there,
I would like to ask for a code for my problem which is i have 3 sheets, let say A,B and C. Sheet B is taking its values from sheet A, i would like a code that when i run it, to deactivate sheet A and activate Sheet C in such Sheet B will take its value from Sheet C not B.
Please advice and thanks in advance

Hi There,
Anyone can please help me on selecting the Titus Classification(Comm Addin) using a VBA, and when i tried using the sendkeys it didnt work.
when the macro is running to select any option in the classification using send keys, the options are acyually invisible in the Command bar.
Am struggling from 1 week just scratching my head to find a resolution for this one.
Please help me out, Thanks in Advance...!!!

Hi KJBox, hope you had a good new year.
You provided me with the below codes that worked great...but since we changed to 2020 I get nothing counted at all. is there a problem with the date in the code?
Code Sub GetCountsCurrentMonth()
 Dim x, y, Rws, ContAreas, i As Long, ii As Long
 Const Category As String = "Work"
 Const Status As String = "Processed"
 Const DtCol As Long = 11 '// Change to suit (11 = column K)
 Rws = Array(5, 6, 7, 8, 9, 17, 18, 19, 20, 21, 22, 23, 24, 32, 33, 34, 35, 36)
 ContAreas = Array("WSCA1", "WSCA2", "SECA11", "SECA12", "SECA13", "NWCA5", "NWCA6A", _
 "NWCA6B", "NWCA7", "NWCA8", "NWCA9", "NWCA10A", "NWCA10B", _
 "WSCA3", "WSCA4", "SECA14", "SECA15", "SECA16")
 x = Sheet1.[a6].CurrentRegion
 ReDim y(1 To 36, 1 To 1)
 For i = 2 To UBound(x, 1)
 If Year(x(i, DtCol)) = Year(Date) And Month(x(i, DtCol)) = Month(Date) _
 And x(i, 4) = Category And x(i, 13) = Status Then
 For ii = LBound(ContAreas) To UBound(ContAreas)
 If ContAreas(ii) = x(i, 12) Then y(Rws(ii), 1) = y(Rws(ii), 1) + 1
 Next
 End If
 Next
 With Sheet2
 .[e1].Resize(36) = y
 .Activate
 End With
 End Sub
Code Sub GetCountsPreviousMonth()
 Dim x, y, Rws, ContAreas, i As Long, ii As Long
 Const Category As String = "Work"
 Const Status As String = "Processed"
 Const DtCol As Long = 11 '// Change to suit (11 = column K)
 Rws = Array(5, 6, 7, 8, 9, 17, 18, 19, 20, 21, 22, 23, 24, 32, 33, 34, 35, 36)
 ContAreas = Array("WSCA1", "WSCA2", "SECA11", "SECA12", "SECA13", "NWCA5", "NWCA6A", _
 "NWCA6B", "NWCA7", "NWCA8", "NWCA9", "NWCA10A", "NWCA10B", _
 "WSCA3", "WSCA4", "SECA14", "SECA15", "SECA16")
 x = Sheet1.[a6].CurrentRegion
 ReDim y(1 To 36, 1 To 1)
 For i = 2 To UBound(x, 1)
 If Year(x(i, DtCol)) = Year(Date) And Month(x(i, DtCol)) = Month(Date)  1 _
 And x(i, 4) = Category And x(i, 13) = Status Then
 For ii = LBound(ContAreas) To UBound(ContAreas)
 If ContAreas(ii) = x(i, 12) Then y(Rws(ii), 1) = y(Rws(ii), 1) + 1
 Next
 End If
 Next
 With Sheet2
 .[e1].Resize(36) = y
 .Activate
 End With
 End Sub
Code Sub GetCountsCurrentQuarter()
 Dim x, y, Rws, ContAreas, i As Long, ii As Long
 Const Category As String = "Work"
 Const Status As String = "Processed"
 Const DtCol As Long = 11 '// Change to suit (11 = column K)
 Rws = Array(5, 6, 7, 8, 9, 17, 18, 19, 20, 21, 22, 23, 24, 32, 33, 34, 35, 36)
 ContAreas = Array("WSCA1", "WSCA2", "SECA11", "SECA12", "SECA13", "NWCA5", "NWCA6A", _
 "NWCA6B", "NWCA7", "NWCA8", "NWCA9", "NWCA10A", "NWCA10B", _
 "WSCA3", "WSCA4", "SECA14", "SECA15", "SECA16")
 x = Sheet1.[a6].CurrentRegion
 ReDim y(1 To 36, 1 To 1)
 For i = 2 To UBound(x, 1)
 If Year(x(i, DtCol)) = Year(Date) And DatePart("q", x(i, DtCol)) = DatePart("q", Date) _
 And x(i, 4) = Category And x(i, 13) = Status Then
 For ii = LBound(ContAreas) To UBound(ContAreas)
 If ContAreas(ii) = x(i, 12) Then y(Rws(ii), 1) = y(Rws(ii), 1) + 1
 Next
 End If
 Next
 With Sheet2
 .[e1].Resize(36) = y
 .Activate
 End With
 End Sub
Code Sub GetCountsPreviousQuarter()
 Dim x, y, Rws, ContAreas, i As Long, ii As Long
 Const Category As String = "Work"
 Const Status As String = "Processed"
 Const DtCol As Long = 11 '// Change to suit (11 = column K)
 Rws = Array(5, 6, 7, 8, 9, 17, 18, 19, 20, 21, 22, 23, 24, 32, 33, 34, 35, 36)
 ContAreas = Array("WSCA1", "WSCA2", "SECA11", "SECA12", "SECA13", "NWCA5", "NWCA6A", _
 "NWCA6B", "NWCA7", "NWCA8", "NWCA9", "NWCA10A", "NWCA10B", _
 "WSCA3", "WSCA4", "SECA14", "SECA15", "SECA16")
 x = Sheet1.[a6].CurrentRegion
 ReDim y(1 To 36, 1 To 1)
 For i = 2 To UBound(x, 1)
 If Year(x(i, DtCol)) = Year(Date) And DatePart("q", x(i, DtCol)) = DatePart("q", Date)  1 _
 And x(i, 4) = Category And x(i, 13) = Status Then
 For ii = LBound(ContAreas) To UBound(ContAreas)
 If ContAreas(ii) = x(i, 12) Then y(Rws(ii), 1) = y(Rws(ii), 1) + 1
 Next
 End If
 Next
 With Sheet2
 .[e1].Resize(36) = y
 .Activate
 End With
 End Sub
ishawn
I have this code and trying to assign a value from the table, way below, to t
Sub FindBestN()
Dim Nstart As Integer 'begining N value by an initial guess
Dim d As Integer 'precision value
Dim units As Integer 'unit length of confidence interval
Dim v As Integer 'degrees of freedom
Dim CI As Integer 'unit width of confidence interval
Dim P As Integer 'probability of value within confidence interval
Dim t As Integer 'tvalue from Student's t Distribution Table
Dim N As Integer 'required number of measurments to reduce estimated value for random error in the sample mean
Dim Sx As Integer 'sample standard deviation
Dim pv As Integer 'population variance
Dim Pchoosen As Integer 'probability choosen
Nstart = InputBox("Enter desired starting N")
v = Nstart  1
P = InputBox("Enter the desired probablility within the cofidence interval from the following integers: 50,90,95,or 99")
If P = 50 Or P = 90 Or P = 95 Or P = 99 Then
Pchoosen = P
Else
P = InputBox("Enter the desired probablility within the cofidence interval from the following integers: 50,90,95,or 99")
End If
CI = InputBox("Enter unit width of confidence interval")
d = CI / 2
t = Application.WorksheetFunction.Index(Sheets("Sheet1").ListObjects("tTable"), v, P)
MsgBox (t)
End Sub