Consulting

Results 1 to 17 of 17

Thread: Need help figuring out what went wrong

  1. #1

    Need help figuring out what went wrong

    I must've redone this code a dozen times trying to get it to work but im pretty new to this and it seems im either burnt out or just not skilled enough. Could someone please help?

    Hopefully I can explain this well enough.

    What I want to do here is go through the A column and run some checks before adding the user input to the sheet.

    1. I need to check if the customers name is already on the list

    2. If its NOT I need to add it along with the other user input, then ask if the user would like to add another.

    3.If the customer IS already on the list I need to check to see if the REFERRED customer is on the list attached to that customer.

    4.Now if the REFERRED customer IS already attached to that customer then I need to display a message and back out.

    5.If the REFERRED customer NOT already attached to that customer then I add it to the list, along with the added amount and ask to process another.

    6. If the total amount is $600 then another message and then ask process another.


    It worked the first two times but now its just stuck on the 4th row overwriting the existing CUSTOMER NAME and adding the REFERRED CUSTOMER to the already established REFERRED CUSTOMER list.


    Here's the code. I am new to VBA so I keep alot of comments to stay on track. Hopefully that isn't too annoying and actually helps you help me.


    Sub AddAnother()'This function updates the screen and saves the workbook
    'Then it ask the user if it wants to process another
        
    'Job is done update screen
        Application.ScreenUpdating = True
    'and save
        ActiveWorkbook.Save
        
    'First we need to store thier answer
        answer = MsgBox("Workbook has been saved." & vbCrLf & "Process Another?", vbYesNo + vbQuestion, "Process Another")
    'If the ansewr is yes then
        If answer = vbYes Then
    'Run again
            Call AddBirdDog
    'If the answer is no then exit
        Else
            Exit Sub
            End If
            
        End Sub
        
        Sub AddBirdDog()
            
        
    'Deselct everything to avoid errors
    Application.CutCopyMode = True
            
    'Turn screen updating off to make it faster
            Application.ScreenUpdating = False
            
            
    ' declar viariable
            Dim ReferersName As String
            Dim ReferersDeal As Long
            Dim ReferredCustomer As String
            Dim ReferredCustomerDeal As Long
            Dim BirdDogAmount As Integer
            
    'get user input
            ReferersName = InputBox("Enter Referers Name" & vbCrLf & "EXAMPLE:" & vbCrLf & "John Smith")
            ReferersDeal = InputBox("Enter Referers Deal Number" & vbCrLf & "EXAMPLE:" & vbCrLf & "123456")
            ReferredCustomer = InputBox("Enter Referred Customer's Name" & vbCrLf & "EXAMPLE:" & vbCrLf & "John Smith")
            ReferredCustomerDeal = InputBox("Enter Referred Customers Deal Number" & vbCrLf & "EXAMPLE:" & vbCrLf & "D123456")
            BirdDogAmount = InputBox("Enter Bird-Dog Amount" & vbCrLf & "EXAMPLE:" & vbCrLf & "100.00")
            
            
            
            
    'Select First cell in column A
            Range("A3").Select
            
    'check cells in column A for Duplicate Referers name
            Do
                
    ' If cell = Referes name then referer has had a birddog before
                If ActiveCell.Value = ReferersName Then
    'So Move to Referred customer column
                    ActiveCell.Offset(0, 2).Select
    'If the value of Referred Customer is contained in the active cell
                    If InStr(1, ActiveCell.Value, ReferredCustomer) <> 0 Then
    'Then customer has already been given a birddog for this customer
    'The customer cannot get a birddog for the same reffered customer
    'Display message and exit
                        MsgBox "Customer " & ReferersName & " Already recieved a Bird-Dog For " & ReferredCustomer & vbCrLf & " See Highlighted", vbCritical, "Already Recieved"
    'Highlight duplicate
                        ActiveCell.EntireRow.Interior.ColorIndex = 6
                        Exit Sub
                    Else
    'Its a new refereal and so we add it to the list
    'Take the value of the cell add a line break and
    'add the new referal and thier deal #
                        ActiveCell.Value = ActiveCell.Value & vbCrLf & ReferredCustomer & "-" & ReferredCustomerDeal
    'Now we need to add the birddog amount to the total for the customer
    'So move to the next cell (YTD BIRDDOG TOTAL)
                        ActiveCell.Offset(0, 1).Select
    'Add the birddog $$$ to the total for the year
                        ActiveCell.Value = ActiveCell.Value + BirdDogAmount
    'Now if the YTD BirdDog Total is greater than or equal to $600
                        If ActiveCell.Value >= 600# Then
    'Customer needs w9 Display message
                            MsgBox "Customer " & ReferersName & " Has $600 or more worth of birddogs" & vbCrLf & "Make sure they get a fills out a W9 in exchange for the check", vbCritical, "GET W9!!!"
                            
    'let user know its saved and ask if they have another birddog to process
    'To do this we call the AddAnother fuction
                            Call AddAnother
                        Else
    'Else if its under 600 just ask if they have another to process
                            
                            Call AddAnother
    'End the check for $600 if
                        End If
    'End the Check for duplicate referred customer if
                    End If
     'else if cell is blank take care of first time run empty cell - Should only be once ... I need to find a better way
                    ElseIf ActiveCell.Value = "" Then
                    
    'Customer is new and we add all the information
    'Add data
                    ActiveCell.Value = ReferersName
                    ActiveCell.Offset(0, 1).Value = ReferersDeal
                    ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, 2).Value & vbCrLf & ReferredCustomer & "-" & ReferredCustomerDeal
                    ActiveCell.Offset(0, 3).Value = BirdDogAmount
    'Ask if they have another
                    Call AddAnother
                    
                    Else
    'First move to next blank cell
                    ActiveCell.Offset(1, 0).Select
     'Customer is new and we add all the information
    'Add data
                    ActiveCell.Value = ReferersName
                    ActiveCell.Offset(0, 1).Value = ReferersDeal
                    ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, 2).Value & vbCrLf & ReferredCustomer & "-" & ReferredCustomerDeal
                    ActiveCell.Offset(0, 3).Value = BirdDogAmount
    'Ask if they have another
                    Call AddAnother
                    
                    
    'End the Rereres check if
                End If
    'Move to the next blank cell so the loop can stop
                ActiveCell.Offset(1, 0).Select
            Loop Until ActiveCell.Value = ""
            
        End Sub
    Attached Files Attached Files

  2. #2
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    Hi, ediaz369.
    Your code is a little messed up, so let's make it step by step.

    First of all, this would be the basic structure of the code. Is it OK so far?

    Sub Test()
        Dim ReferrersName As String
        Dim foundCell As Range
        
        ReferrersName = InputBox("Enter Referrers Name")
    
    
        '1. I need to check if the customers name is already on the list
        Set foundCell = Range("A:A").Find(What:=ReferrersName, LookAt:=xlWhole, MatchCase:=False)
        
        If foundCell Is Nothing Then
            '2. If its NOT I need to add it along with the other user input,
            ' then ask if the user would like to add another.
        Else
            '3. If the customer IS already on the list I need to check to see
            ' if the REFERRED customer is on the list attached to that customer.
            
            'Shows the info for example
            MsgBox foundCell.Address & vbNewLine & _
                    foundCell.Offset(, 1) & vbNewLine & _
                    foundCell.Offset(, 2) & vbNewLine & _
                    foundCell.Offset(, 3)
        End If
    End Sub

  3. #3
    Yes! This works so far. Does nothing if not found and displays the info if it is.

    Jeez that 1 line takes care of going through each cell and the check. I think I understand what you did there though. Going to try and find some references to it just to make sure I get a full understanding though.

  4. #4
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    OK, let's go to the next step.
    Here we add the information when the customer is new.

    Sub Test()
        Dim ReferrersName As String
        Dim ReferrersDeal As Long
        Dim ReferredCustomer As String
        Dim ReferredCustomerDeal As Long
        Dim BirdDogAmount As Integer
        Dim foundCell As Range
        
        ReferrersName = InputBox("Enter Referrers Name")
    
        '1. I need to check if the customers name is already on the list
        Set foundCell = Range("A:A").Find(What:=ReferrersName, LookAt:=xlWhole, MatchCase:=False)
        
        If foundCell Is Nothing Then
            '2. If its NOT I need to add it along with the other user input,
            ' then ask if the user would like to add another.
            
            ReferrersDeal = InputBox("Enter Referrers Deal Number")
            ReferredCustomer = InputBox("Enter Referred Customer's Name")
            ReferredCustomerDeal = InputBox("Enter Referred Customers Deal Number")
            BirdDogAmount = InputBox("Enter Bird-Dog Amount")
    
          '"Cells(Rows.Count, "A").End(xlUp)" returns the last cell that contains data in the column "A".
            With Cells(Rows.Count, "A").End(xlUp)
                .Offset(1, 0) = ReferrersName
                .Offset(1, 1) = ReferrersDeal
                .Offset(1, 2) = ReferredCustomer & "-" & ReferredCustomerDeal
                .Offset(1, 3) = BirdDogAmount
            End With
    
        Else
            '3. If the customer IS already on the list I need to check to see
            ' if the REFERRED customer is on the list attached to that customer.
            
            'Shows the info for example
            MsgBox foundCell.Address & vbNewLine & _
                    foundCell.Offset(, 1) & vbNewLine & _
                    foundCell.Offset(, 2) & vbNewLine & _
                    foundCell.Offset(, 3)
        End If
    End Sub

  5. #5
    Good so far.

  6. #6
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    Next, when the customer is found in the list, we check the Reffered Customer column.

    Sub Test()
        Dim ReferrersName As String
        Dim ReferrersDeal As Long
        Dim ReferredCustomer As String
        Dim ReferredCustomerDeal As Long
        Dim BirdDogAmount As Integer
        Dim foundCell As Range
        
        ReferrersName = InputBox("Enter Referrers Name")
    
        '1. I need to check if the customers name is already on the list
        Set foundCell = Range("A:A").Find(What:=ReferrersName, LookAt:=xlWhole, MatchCase:=False)
        
        If foundCell Is Nothing Then
            '2. If its NOT I need to add it along with the other user input,
            ' then ask if the user would like to add another.
            
            ReferrersDeal = InputBox("Enter Referrers Deal Number")
            ReferredCustomer = InputBox("Enter Referred Customer's Name")
            ReferredCustomerDeal = InputBox("Enter Referred Customers Deal Number")
            BirdDogAmount = InputBox("Enter Bird-Dog Amount")
            
           '"Cells(Rows.Count, "A").End(xlUp)" returns the last cell that contains data in the column "A".
            With Cells(Rows.Count, "A").End(xlUp)
                .Offset(1, 0) = ReferrersName
                .Offset(1, 1) = ReferrersDeal
                .Offset(1, 2) = ReferredCustomer & "-" & ReferredCustomerDeal
                .Offset(1, 3) = BirdDogAmount
            End With
    
        Else
            '3. If the customer IS already on the list I need to check to see
            ' if the REFERRED customer is on the list attached to that customer.
            
            ReferredCustomer = InputBox("Enter Referred Customer's Name")
            
            With foundCell
                If InStr(.Offset(, 2), ReferredCustomer & "-") = 0 Then
                    ReferredCustomerDeal = InputBox("Enter Referred Customers Deal Number")
                    BirdDogAmount = InputBox("Enter Bird-Dog Amount")
                    
                    .Offset(, 1) = ReferrersDeal
                    .Offset(, 2) = .Offset(, 2) & vbLf & ReferredCustomer & "-" & ReferredCustomerDeal
                    .Offset(, 3) = .Offset(, 3) + BirdDogAmount
                    If .Offset(, 3) >= 600 Then
                        MsgBox "Customer " & ReferrersName & " Has $600 or more worth of birddogs", vbCritical
                    End If
                Else
                    MsgBox "Customer " & ReferrersName & " Already recieved a Bird-Dog For " & ReferredCustomer & vbNewLine & _
                        " See Highlighted", vbCritical, "Already Recieved"
                    .EntireRow.Interior.ColorIndex = 6
                End If
            End With
        End If
    End Sub

  7. #7
    No errors here. Gosh I noticed I went IF crazy on the original.

  8. #8
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    This would be the final step.
    Call the Test code from the Main procedure and repeat until you click "No" in the message box.

    Sub Test_Main()
        Dim Answer
        
        Do
            DoEvents
            Call Test
            Answer = MsgBox("Process Another?", vbYesNo + vbQuestion)
        Loop Until Answer = vbNo
    End Sub
    MsgBox "Customer " & ReferrersName & " Already recieved a Bird-Dog For " & ReferredCustomer & vbNewLine & _ " See Highlighted", vbCritical, "Already Recieved"
    .EntireRow.Interior.ColorIndex = 6
    BTW, I wonder what we're going to do with the highlighted row after they check it out?
    'Cause it remains until we turn it off.

  9. #9
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    Oops, I've found one mistake.
    Please delete the line 42 of the Test procedure.
    .Offset(, 1) = ReferrersDeal

  10. #10
    In the original ReferredCustomerDeal is defined as a Long value, but you quoted the example as 'D123456' which means it should be a String value.
    Similarly BirdDogAmount is defined as Integer when you appear to have decimals in your example, so it needs to be a Long value here.
    Put Option Explicit at the top of the module and it will make variable errors easier to spot.
    I would also suggest using a Userform rather than assorted input boxes to collect the values.
    As for the rest I don't understand what it is that you are trying to do with your worksheet and the example sheet is not helpful in resolving that.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by gmayor View Post
    …BirdDogAmount is defined as Integer when you appear to have decimals in your example, so it needs to be a Long value here.
    Long is a whole number too! Try Single/Double/Currency or just plain Variant (which doesn't need declaring as such since it's the default/implicit).
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  12. #12
    Quote Originally Posted by p45cal View Post
    Long is a whole number too! Try Single/Double/Currency or just plain Variant (which doesn't need declaring as such since it's the default/implicit).
    You are of course correct - what was I thinking ... or, as it turns out, not thinking
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  13. #13
    Quote Originally Posted by gmayor View Post
    In the original ReferredCustomerDeal is defined as a Long value, but you quoted the example as 'D123456' which means it should be a String value.
    Similarly BirdDogAmount is defined as Integer when you appear to have decimals in your example, so it needs to be a Long value here.
    Put Option Explicit at the top of the module and it will make variable errors easier to spot.
    I would also suggest using a Userform rather than assorted input boxes to collect the values.
    As for the rest I don't understand what it is that you are trying to do with your worksheet and the example sheet is not helpful in resolving that.
    Thanks. I was bouncing around between versions of my code and forgot to change the comments sometimes. In this case I forgot to omit the "D". Still working on memorizing these types though.

  14. #14
    Quote Originally Posted by yujin View Post
    This would be the final step.
    Call the Test code from the Main procedure and repeat until you click "No" in the message box.

    Sub Test_Main()
        Dim Answer
        
        Do
            DoEvents
            Call Test
            Answer = MsgBox("Process Another?", vbYesNo + vbQuestion)
        Loop Until Answer = vbNo
    End Sub


    BTW, I wonder what we're going to do with the highlighted row after they check it out?
    'Cause it remains until we turn it off.
    I planned on removing it on next start but wasn't sure how to go about it. I kinda added things as I thought of them, thats one of my many problems, I get all excited if I can add a feature but I dont take into account what it means programming wise.

  15. #15
    Quote Originally Posted by p45cal View Post
    Long is a whole number too! Try Single/Double/Currency or just plain Variant (which doesn't need declaring as such since it's the default/implicit).
    Makes sense to go with currency then. Thanks

  16. #16
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    I've modified the code.

    Added the code to turn off the highlight, the code for when the cancel button of the input boxes are hit, and changed some data types.

    Option Explicit
    
    Sub Test_Main()
        Dim Answer
        
        'Turn off the highlight
        Range(Rows(3), Rows(Rows.Count)).Interior.ColorIndex = xlNone
        
        Do
            DoEvents
            Call Test
            Answer = MsgBox("Process Another?", vbYesNo + vbQuestion)
        Loop Until Answer = vbNo
    End Sub
    
    Sub Test()
        Dim ReferrersName As String
        Dim ReferrersDeal As Long
        Dim ReferredCustomer As String
        Dim ReferredCustomerDeal As Long
        Dim BirdDogAmount As Currency
        Dim foundCell As Range
        
        ReferrersName = InputBox("Enter Referrers Name")
        If StrPtr(ReferrersName) = 0 Then Exit Sub
        
        '1. I need to check if the customers name is already on the list
        Set foundCell = Range("A:A").Find(What:=ReferrersName, LookAt:=xlWhole, MatchCase:=False)
        
        If foundCell Is Nothing Then
            '2. If its NOT I need to add it along with the other user input,
            ' then ask if the user would like to add another.
            
            ReferrersDeal = InputBox("Enter Referrers Deal Number")
            If StrPtr(ReferrersDeal) = 0 Then Exit Sub
            ReferredCustomer = InputBox("Enter Referred Customer's Name")
            If StrPtr(ReferredCustomer) = 0 Then Exit Sub
            ReferredCustomerDeal = InputBox("Enter Referred Customers Deal Number")
            If StrPtr(ReferredCustomerDeal) = 0 Then Exit Sub
            BirdDogAmount = InputBox("Enter Bird-Dog Amount")
            If StrPtr(BirdDogAmount) = 0 Then Exit Sub
            
           '"Cells(Rows.Count, "A").End(xlUp)" returns the last cell that contains data in the column "A".
            With Cells(Rows.Count, "A").End(xlUp)
                .Offset(1, 0) = ReferrersName
                .Offset(1, 1) = ReferrersDeal
                .Offset(1, 2) = ReferredCustomer & "-" & ReferredCustomerDeal
                .Offset(1, 3) = BirdDogAmount
            End With
    
        Else
            '3. If the customer IS already on the list I need to check to see
            ' if the REFERRED customer is on the list attached to that customer.
            
            ReferredCustomer = InputBox("Enter Referred Customer's Name")
            If StrPtr(ReferredCustomer) = 0 Then Exit Sub
            
            With foundCell
                If InStr(.Offset(, 2), ReferredCustomer & "-") = 0 Then
                    ReferredCustomerDeal = InputBox("Enter Referred Customers Deal Number")
                    If StrPtr(ReferredCustomerDeal) = 0 Then Exit Sub
                    BirdDogAmount = InputBox("Enter Bird-Dog Amount")
                    If StrPtr(BirdDogAmount) = 0 Then Exit Sub
                    
                    .Offset(, 2) = .Offset(, 2) & vbLf & ReferredCustomer & "-" & ReferredCustomerDeal
                    .Offset(, 3) = .Offset(, 3) + BirdDogAmount
                    If .Offset(, 3) >= 600 Then
                        MsgBox "Customer " & ReferrersName & " Has $600 or more worth of birddogs", vbCritical
                    End If
                Else
                    MsgBox "Customer " & ReferrersName & " Already recieved a Bird-Dog For " & ReferredCustomer & vbNewLine & _
                        " See Highlighted", vbCritical, "Already Recieved"
                    .EntireRow.Interior.ColorIndex = 6
                    End 'Macro ends
                End If
            End With
        End If
    End Sub

  17. #17
    Quote Originally Posted by yujin View Post
    I've modified the code.

    Added the code to turn off the highlight, the code for when the cancel button of the input boxes are hit, and changed some data types.
    Thanks again! I'll have to look this over so I understand fully what is happening.

    Thanks again!.

Posting Permissions

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