Online

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
3,126
  • 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

  • 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



    Student's t Distribution (Two-Sided)
    v 50 90 95 99
    1 1.000 6.314 12.706 63.657
    2 0.816 2.920 4.303 9.925
    3 0.765 2.353 3.182 5.841
    4 0.741 2.132 2.770 4.604
    5 0.727 2.015 2.571 4.032
    6 0.718 1.943 2.447 3.707
    7 0.711 1.895 2.365 3.499
    8 0.706 1.860 2.306 3.355
    9 0.703 1.833 2.262 3.250
    10 0.700 1.812 2.228 3.169
    11 0.697 1.796 2.201 3.106
    12 0.695 1.782 2.179 3.055
    13 0.694 1.771 2.160 3.012
    14 0.692 1.761 2.145 2.977
    15 0.691 1.753 2.131 2.947
    16 0.690 1.746 2.120 2.921
    17 0.689 1.740 2.110 2.898
    18 0.688 1.734 2.101 2.878
    19 0.688 1.729 2.093 2.861
    20 0.687 1.725 2.086 2.845
    21 0.686 1.721 2.080 2.831
    30 0.683 1.697 2.042 2.750
    40 0.681 1.684 2.021 2.704
    50 0.680 1.679 2.010 2.679
    60 0.679 1.671 2.000 2.660
    0.674 1.645 1.960 2.576
  • Hi I trust you and your Family are keeping well


    I tried to send something on Whats app but it needed a code from you now.

  • Hi Charles


    How are you and your Family going keeping well I trust ?????

  • 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

  • Hey Charles! I was about post in the Hire Help section and I saw that you were actively on line. Do you have some time to help me out. I'm up against a deadline and I need some backup.

  • 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...!!!:):)

  • hello Charles, hope you are well.

  • 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?

    • Hi KjBox just reminding you the code you gave me has Option Base 1 in it and now the data has some 2020 dates in it they appear after I run the macro but none of the 2019 dates

  • KjBox if you kind enough to donate some time to me to solve the query which i have posted since no one is replying on that ..thanks u had helped me many times.

  • I opened a conversation with you about a VBA problem I'm having - mind taking a look?

    Thank you!!!

  • Good morning and how are we this morning. ????

  • KjBox is excellent......has helped me so much with VBA codes. A real expert. Thanks for everything.