Posts by Krishnakumar

    Re: USD$35 to automate email notifications from excel data sheet


    Few questions.


    1. Do you have any specific message body and subject line to follow ? Can I use a mapping sheet for this so that you can edit the message at any point of time ?
    2. Different officers could open this file in multiple times - in this case same mail will be sent(multiple times) by their email id, am I rightly understood?
    Also is this workbook placed in a shared drive so that multiple users can access this file ? If not how these information got updated on their respective workbooks ?
    3. I assume every officers are using Outlook as their default email client.

    Re: VBA Highlight Rows Based on Name Count


    Couple of things. First you convert the table into a range, since the whole data need to sort first. 3 column Table between the range create problem while sorting. Also I found some formulas in between the data. After doing these changes, run the macro.


    [vb]Option Explicit

    Sub AuditHighlights()

    Dim k, dic As Object, r As Range, i As Long, p As Long
    Dim j As Long, n As Long, wf As WorksheetFunction
    Dim c(1) As Long, m As Long, dicRatio As Object

    Set dic = CreateObject("scripting.dictionary")
    dic.comparemode = 1

    Set dicRatio = CreateObject("scripting.dictionary")
    dicRatio.comparemode = 1

    Set wf = Application.WorksheetFunction

    With Worksheets("Raw Data")
    Set r = .Cells(1).CurrentRegion.Resize(, 14)
    k = .Range("u1").CurrentRegion.Value2 'director count
    End With

    For i = 2 To UBound(k, 1)
    If Not IsError(k(i, 1)) Then
    dicRatio.Item(k(i, 1)) = Array(k(i, 2), wf.Round(k(i, 3), 0))
    End If
    Next

    With r
    .Sort .Cells(2, 10), xlAscending, Header:=xlYes 'sort by director
    .Interior.ColorIndex = -4142
    k = .Value
    For i = 2 To .Rows.Count
    If Not IsError(k(i, 10)) Then dic.Item(k(i, 10)) = i
    Next
    k = Array(dic.keys, dic.items)
    c(0) = 65535 'yellow
    c(1) = 65280 'green
    p = 1
    For i = 0 To UBound(k(0))
    If i Then p = k(1)(i - 1)
    m = dicRatio.Item(k(0)(i))(0)
    dic.RemoveAll
    j = 1
    Do While j <= dicRatio.Item(k(0)(i))(1)
    n = wf.RandBetween(1, m)
    If Not dic.exists(n) Then
    .Rows(p + n).Interior.Color = c(i Mod 2)
    dic.Item(n) = n
    j = j + 1
    End If
    Loop
    Next
    End With

    End Sub[/vb]

    Re: Range to Array and then Redim Preserve


    Hi ,


    Welcome to board !!!


    [vb] 'UniqueIDs = Application.Transpose(UniqueIDs)'do not transpose here
    ReDim Preserve UniqueIDs(1 To UBound(UniqueIDs) + 1)
    UniqueIDs(UBound(UniqueIDs)) = 10

    wsu.Range("B1").Resize(UBound(UniqueIDs)) = Application.Transpose(UniqueIDs)[/vb]

    Re: VBA Highlight Rows Based on Name Count


    Hi


    [vb]Option Explicit


    Sub kTest()

    Dim k, dic As Object, r As Range, i As Long, p As Long
    Dim j As Long, n As Long, wf As WorksheetFunction
    Dim c(1) As Long, m As Long, dicRatio As Object

    Set dic = CreateObject("scripting.dictionary")
    dic.comparemode = 1

    Set dicRatio = CreateObject("scripting.dictionary")
    dicRatio.comparemode = 1

    Set wf = Application.WorksheetFunction

    With Worksheets("Raw Data")
    Set r = .Cells(1).CurrentRegion.Resize(, 4)
    k = .Range("k1").CurrentRegion.Value2
    End With

    For i = 2 To UBound(k, 1)
    If Not IsError(k(i, 1)) Then
    dicRatio.Item(k(i, 1)) = Array(k(i, 2), wf.Round(k(i, 3), 0))
    End If
    Next

    With r
    .Sort .Cells(2, 2), xlAscending, Header:=xlYes
    .Interior.ColorIndex = -4142
    k = .Value
    For i = 2 To .Rows.Count
    If Not IsError(k(i, 2)) Then dic.Item(k(i, 2)) = i
    Next
    k = Array(dic.keys, dic.items)
    c(0) = 65535 'yellow
    c(1) = 65280 'green
    p = 1
    For i = 0 To UBound(k(0))
    If i Then p = k(1)(i - 1)
    m = dicRatio.Item(k(0)(i))(0)
    dic.RemoveAll
    For j = 1 To dicRatio.Item(k(0)(i))(1)
    n = wf.RandBetween(1, m)
    If Not dic.exists(n) Then
    .Rows(p + n).Interior.Color = c(i Mod 2)
    dic.Item(n) = n
    End If
    Next
    Next
    End With

    End Sub[/vb]

    Re: Six Dependent Cascading ComboBoxs's issue.


    Quote from SCOM;793721

    Again, awesome... Exactly what I needed. Thank You so much...


    Thanks!


    Quote from SCOM;793721

    ... One more question if you don't mind...Is it possible to have a label name dynamic based on the selection of a ComboBox? I need to be able to have the label name for a textbox change based on the process selected from a combox3. Suggestions? Thanks Again.


    Since your original query has been answered, you should start a new thread with the new request.

    Re: Six Dependent Cascading ComboBoxs's issue.


    Replace the ComboBox6_Change event with


    [vb]Private Sub ComboBox6_Change()

    Dim i As Long

    If Me.ComboBox6.ListIndex = -1 Then
    For i = 1 To 30
    Me.Controls("TextBox" & i).Value = vbNullString
    Next
    Me.ListBox1.Clear
    Me.ListBox2.Clear
    Else
    GetData
    End If

    End Sub[/vb]

    Re: Six Dependent Cascading ComboBoxs's issue.


    Add these procedures in the userform module.


    [vb]Private Sub ComboBox6_Change()

    GetData

    End Sub


    Private Sub GetData()

    Dim i As Long
    Dim k, j As Long
    Dim S1 As String
    Dim S2 As String

    k = Sheet1.Cells(1).CurrentRegion.Resize(, 32).Value

    With Me
    For j = 1 To 6
    S1 = S1 & "|" & .Controls("ComboBox" & j).Value
    Next

    For i = 2 To UBound(k, 1)
    S2 = vbNullString
    For j = 1 To 6
    S2 = S2 & "|" & k(i, j)
    Next
    If S1 = S2 Then
    .ListBox1.Clear: .ListBox2.Clear
    .ListBox1.AddItem k(i, 7)
    .ListBox2.AddItem k(i, 8)
    For j = 9 To UBound(k, 2)
    .Controls("TextBox" & j - 8).Value = k(i, j)
    Next
    Exit For
    End If
    Next
    End With

    End Sub[/vb]

    Re: Add a second range to a scripting dictionary



    Have you tested what I suggested ?