
KjBox OzMVP - Super Moderator
- Male
- from Kuching, Borneo
- Member since Jan 10th 2007
- Last Activity:
- Dashboard
- Posts
- 4,436
- Likes Received
- 73
- Points
- 13,507
- Trophies
- 1
- Profile Hits
- 3,320
-
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 't-value 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
-
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 (VBA-USERFORM)
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 covid-19. !!!
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
Nikhil_Narwade
Hi...need your help with multiple dependent combobox. I have 3 combobox and if any one of the 3 is selected based of the selection the other 2 should get refreshed.
Here is the code --
Private Sub ComboBox1_Change()
Dim rng As Range
Dim r As Range
Dim Dic As Object
Dim sh As Worksheet
Dim ws As Worksheet
Dim i As Integer
Dim cb As ComboBox
Dim ar As Variant
Set sh = Sheet2 'Calc Sheet
Set ws = Sheet3 'List Sheet
ar = Array("All Sub Categories", "All Grades")
Application.EnableEvents = False
Set rng = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Set sh = Sheet2
For Each r In rng
If r = ComboBox1 Then
Dic(r.Offset(, 1).Value) = Empty
End If
Next
With ComboBox2 'Add data to the comboboxes
.List = Application.Transpose(Dic.keys)
.AddItem "All Categories", 0
.ListIndex = 0
End With
'Add to cb 3 & 4
For i = 3 To 4
Dic.RemoveAll
For Each r In rng
If r = ComboBox1 Then
Dic(r.Offset(, i - 1).Value) = Empty
End If
Next
Set cb = Sheet1.Shapes("ComboBox" & i).OLEFormat.Object.Object
With cb 'Add data to the comboboxes
.List = Application.Transpose(Dic.keys)
.AddItem ar(i - 2), 0
.ListIndex = 0
End With
Next i
For i = 1 To 4 'Loop through the comboboxes
Set cb = Sheet1.Shapes("ComboBox" & i).OLEFormat.Object.Object
'sh.Activate
'sh.Cells(2, i + 1).Select
sh.Cells(2, i + 1) = cb.Value
Next i
Application.EnableEvents = True
End Sub
Private Sub ComboBox2_Change()
Dim rng As Range
Dim r As Range
Dim Dic As Object
Dim i As Integer
Dim cb As ComboBox
Dim sh As Worksheet
Dim ws As Worksheet
Set sh = Sheet2 'Calc Sheet
Set ws = Sheet3 'List Sheet
Application.EnableEvents = False
Set rng = ws.Range("B2", ws.Range("B" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
If ComboBox2 = "All Categories" Then
For Each r In rng
Dic(r.Offset(, 1).Value) = Empty
Next
Else
'Only items that relate to Combo 2
For Each r In rng
If r = ComboBox2 Then
Dic(r.Offset(, 1).Value) = Empty
End If
Next
End If
With ComboBox3 'Add data to the comboboxes
.List = Application.Transpose(Dic.keys)
.AddItem "All Sub Categories", 0
.ListIndex = 0
End With
Dic.RemoveAll
'Only items that relate to Combo 2
For Each r In rng
If r = ComboBox2 Then
Dic(r.Offset(, 2).Value) = Empty
End If
Next
With ComboBox4 'Add data to the comboboxes
.List = Application.Transpose(Dic.keys)
.AddItem "All Grades", 0
.ListIndex = 0
End With
sh.[c2] = ComboBox2.Value
Application.EnableEvents = True
End Sub
Private Sub ComboBox3_Change()
Dim rng As Range
Dim r As Range
Dim Dic As Object
Dim sh As Worksheet
Dim ws As Worksheet
Set sh = Sheet2 'Calc Sheet
Set ws = Sheet3 'List Sheet
Application.EnableEvents = False
Set rng = ws.Range("C2", ws.Range("C" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
If ComboBox3 = "All Sub Categories" Then
For Each r In rng
Dic(r.Offset(, 1).Value) = Empty
Next
Else
'Only items that relate to Combo 3
For Each r In rng
If r = ComboBox3 Then
Dic(r.Offset(, 1).Value) = Empty
End If
Next
End If
With ComboBox4
.List = Application.Transpose(Dic.keys)
.AddItem "All Grades", 0
.ListIndex = 0
End With
sh.[D2] = ComboBox3.Value
Application.EnableEvents = True
End Sub
Private Sub ComboBox4_Change()
Dim sh As Worksheet
Set sh = Sheet2 'Calc Sheet
Application.EnableEvents = False
sh.[E2] = ComboBox4.Value
Application.EnableEvents = True
End Sub