Consulting

Results 1 to 10 of 10

Thread: Press button to assign the reason provided and count

  1. #1
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location

    Press button to assign the reason provided and count

    Alas our poor industrious boys are in trouble again. The Accountant (Paul) noticed after reviewing last years financials that on some days the two enterprising young lads did not earn any income. Suspicious that maybe one or both were not at work that day, he set up a new form to determine if and why they were absent from work. I need a way to enable our industrious lads to account for their absence, hence the WhereYaBin questionnaire. I need a way to select the person submitting the reason from a DV cell Sheet1 J9, and the reason Sheet1 K9, also a DV cell. Because I am working on a Mac I can't use an active X button.

    So any code needs to be assigned to the Shape "Submit Reason" after both a Name and a reason has been completed. The results need to recorded on sheet3 F3:I3 and down for each new occurrence. The count variable (Cell I3) needs to count only the number of times a particular reason has occurred and a Date on which the reason was submitted. The date is important to stop Zack (who is known to be somewhat mischievous), from sitting there tapping away throwing his partner under the bus. So only one submitted reason per day if possible.
    Attached Files Attached Files
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Some things to consider

    The 'dual' lookup (PN and Desc) didn't really work. Changed formulas to always use PN, and Desc to use PN and PN to get Desc

    I added a Lads absence feature based on my guesses

    Made use of WB and WS events

    Made the .Names dynamic so you can just add / delete

    Rearranged some stuff and created some new .Names (sorry)



    Option Explicit
    
    
    Private Sub Workbook_Open()
        Init
    End Sub
    Option Explicit
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim r As Range, rLad As Range
        Dim iLad As Long
        
        Set r = Target.Cells(1, 1)
        
        Application.EnableEvents = False
        Select Case r.Address
            Case "$D$8"
                Range("$D$9").Value = Application.Evaluate("=XLOOKUP(D8,PartNum,PartDesc,"""",0,1)")
            Case "$D$9"
                Range("$D$8").Value = Application.Evaluate("=XLOOKUP(D9,PartDesc,PartNum,"""",0,1)")
        
            Case "$H$9", "$J$9"
                If Len(Range("H9").Value) > 0 And Len(Range("J9").Value) > 0 Then
                    iLad = Application.Evaluate("=XMATCH(H9,Lads,0,1)")
                    Set rLad = [Lads].Cells(iLad, 1)
                    Set rLad = rLad.Offset(0, 1)
                    
                    If CLng(rLad.Value) = CLng(Date) Then
                        Call MsgBox("Sorry, you only get one", vbCritical + vbOKOnly, "Taking Off")
                        Range("H9").Value = vbNullString
                        Range("J9").Value = vbNullString
                    
                    Else
                        rLad.Value = DateSerial(Year(Now), Month(Now), Day(Now))
                        Range("H9").Value = vbNullString
                        Range("J9").Value = vbNullString
                    End If
                End If
        End Select
        Application.EnableEvents = True
    End Sub
    Option Explicit
    
    
    Public wsStore As Worksheet, wsInput As Worksheet
    
    
    Sub Init()
    
    ....
    ....
    ....
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Sorry Paul but a couple of issues with your version. Firstly in the VBE I notice the you have Sheet2 (Storeman Sheet), and Sheet3 (Sheet2). Will that cause an issue down the track?

    Also, the count for the number of times an excuse has been used does not increase.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Firstly in the VBE I notice the you have Sheet2 (Storeman Sheet), and Sheet3 (Sheet2). Will that cause an issue down the track?
    Capture.JPGCapture2.JPG

    Not seeing Sheet3 or Sheet2 anywhere in the code. "Sheet2" in "Sheet2 (Storeman Sheet)" is the .CodeName, and "Sheet1" in "Sheet1 (Sheet1)" is the .Name


    Also, the count for the number of times an excuse has been used does not increase.


    I didn't know if you wanted the count by Lad or just totaled since I could interpert
    So only one submitted reason per day if possible.
    several different ways

    a. #times used by any Lad any Date - #reasons x 2 -- keep going forever, what you have in now
    b. #times used by each Lad any Date - #reasons x # Lads x 2 -- keep going forever, add column for each Lad
    c
    . #times used by each Lad by each Date - #reasons x # Lads x #days -- keep going forever, add Date column and column for each Lad

    d. #times used by any Lad today - #reasons x 2 (reset each day)
    e. #times used by each Lad today - #reasons x #Lads x 2 (reset each day)


    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Oops. My apologies to you, as a third sheet had been created from this end. Might just go Lad name, Date and reason and reason count, if possible please?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Might just go Lad name, Date and reason and reason count, if possible please?
    Sure -- Excel can do ANYTHING

    It sounds like a log file, and would probably look like this

    IS this what you want?


    Capture.JPG

    On 5/21 Paul had 6 absences - 3 for lady tourist, 1 for spider, and 2 for mother in law

    My dummy data might be unrealistic, but I was just thinking on the data structure
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Hmmm.... Would it be possible for the count to go the other way? As in 1 for the first time of use and 3rd for when the Grandmother apparently died for the third time?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  8. #8
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    For the parts lookup on this version - maybe:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Application.EnableEvents = False
        If Not Intersect(Target, Range("B8:D9")) Is Nothing Then
            If Target.Address = "$D$8" Then
                Range("D8:D11").Value = Evaluate("TOCOL(XLOOKUP(" & Target.Address & ",'Storeman''s Sheet'!A:A,'Storeman''s Sheet'!A:D,"""",0),3)")
            Else
                Range("D8:D11").Value = Evaluate("TOCOL(XLOOKUP(" & Target.Address & ",'Storeman''s Sheet'!B:B,'Storeman''s Sheet'!A:D,"""",0),3)")
            End If
        End If
        Application.EnableEvents = True
    End Sub
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  9. #9
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    See if this floats your boat


    Option Explicit
    
    
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim r As Range
        Dim iLad As Long
        Dim sLad As String, sReason As String
        
        Set r = Target.Cells(1, 1)
        
        Application.EnableEvents = False
        Select Case r.Address
            Case "$D$8"
                Range("$D$9").Value = Application.Evaluate("=XLOOKUP(D8,PartNum,PartDesc,"""",0,1)")
            Case "$D$9"
                Range("$D$8").Value = Application.Evaluate("=XLOOKUP(D9,PartDesc,PartNum,"""",0,1)")
        
            Case "$H$9", "$J$9"
                sLad = Range("H9").Value
                sReason = Range("J9").Value
                
                'only place I like GoTo's since IMHO is makes the flow easier to follow
                If Len(sLad) = 0 Then GoTo NiceExit
                If Len(sReason) = 0 Then GoTo NiceExit
                    
                With wsStats
                    
                    'empty list, only headers so add as row 2
                    If .Cells(1, 1).CurrentRegion.Rows.Count = 1 Then
                        .Cells(2, 1).Value = DateSerial(Year(Now), Month(Now), Day(Now))
                        .Cells(2, 2).Value = sLad
                        .Cells(2, 3).Value = sReason
                        .Cells(2, 4).Value = 1
                        
                        GoTo AllDone
                    End If
                    
                    'first one of the day, any Lad so add at bottom
                    iLad = .Cells(1, 1).CurrentRegion.Rows.Count
                    If CLng(.Cells(iLad, 1).Value) < CLng(DateSerial(Year(Now), Month(Now), Day(Now))) Then
                        .Cells(iLad + 1, 1).Value = DateSerial(Year(Now), Month(Now), Day(Now))
                        .Cells(iLad + 1, 2).Value = sLad
                        .Cells(iLad + 1, 3).Value = sReason
                        .Cells(iLad + 1, 4).Value = 1
                        
                        GoTo AllDone
                    End If
                            
                    
                    'start at bottom go up looking for Lad and Reason on Today
                    iLad = .Cells(1, 1).CurrentRegion.Rows.Count
                    
                    Do While .Cells(iLad, 1).Value = DateSerial(Year(Now), Month(Now), Day(Now))
                        If .Cells(iLad, 2).Value = sLad And .Cells(iLad, 3).Value = sReason Then
                            .Cells(iLad, 4).Value = .Cells(iLad, 4).Value + 1
                            
                            GoTo AllDone
                        Else
                            iLad = iLad - 1
                            
                            If iLad = 1 Then Exit Do
                        End If
                    Loop
                    
                    'if we got this far, we did not find matching Date, Lad and Reason so add at bottom
                    'yes, I know it'sthe same as 'first one of day, but I like the flow
                    iLad = .Cells(1, 1).CurrentRegion.Rows.Count
                    .Cells(iLad + 1, 1).Value = DateSerial(Year(Now), Month(Now), Day(Now))
                    .Cells(iLad + 1, 2).Value = sLad
                    .Cells(iLad + 1, 3).Value = sReason
                    .Cells(iLad + 1, 4).Value = 1
                        
                    GoTo AllDone
                End With
                
    AllDone:
                'clear Lad and Reson
                Range("H9").Value = vbNullString
                Range("J9").Value = vbNullString
                
    NiceExit:
        End Select
        
        Application.EnableEvents = True
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  10. #10
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Floats... I've had to lengthen the anchor chain. Thank you for your contribution.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •