ediaz369
02-09-2018, 07:43 PM
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
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