0

Background: The code you will view below is for a guest list. When executed, it will ask for a list of first names, a list of last names, a list of email addresses, a point value, and an event name. Then, the program enters the event name on the first row of the first empty column. Then, the if loop checks each name that it was supplied to as a list against an existing list in a spreadsheet. If the first and last name are found, it adds the point value to the new event column for that row. If the name is not found, it adds the first and last name to a new row at the bottom, the email address, two formulas for totals, and then the point value within the new column. This is the intended scenario.

I first obtain a list of names with the following code

Dim fNameStringRange As Range

fNameStringRange = Application.InputBox("Select the list of first names.", "Obtain Range Object", Type:=8)

Then I convert it using the user function RangeToArray. The code for this is below:

Function RangeToArray(inputRange As Range) As Variant
Dim inputArray As Variant
inputArray = inputRange.Value

'operations on inputArray
'...'

RangeToArray = inputArray
End Function



Dim fNameString As Variant

fNameString = RangeToArray(fNameStringRange)

For some reason however, my code does not process this through as such. When I have it fill these names into my sheet, it doesn't fill in anything. Before, this would work just fine using a InputBox of type:=2. Any assistance is appreciated. My full VBA script is below:

Sub addEvent()


On Error Resume Next

Dim fNameStringRange As Range
Dim lNameStringRange As Range
Dim sEmailStringRange As Range
Dim fNameString As Variant
Dim lNameString As Variant
Dim sEmailString As Variant
Dim nPointVal As Integer
Dim sEventName As String
Dim n As Integer, r As Long, c As Range, d As Range, e As Range, p As Range, sE As Range
Dim fName As Range, lName As Range, sEmail As Range, z As Range
Dim lEvent As Integer
Set fName = ActiveSheet.Range("FirstName")
Set lName = ActiveSheet.Range("LastName")
Set sEmail = ActiveSheet.Range("eMailAddr")


fNameStringRange = Application.InputBox("Select the list of first names.", "Obtain Range Object", Type:=8)
lNameStringRange = Application.InputBox("Select the list of last names.", "Obtain Range Object", Type:=8)
sEmailStringRange = Application.InputBox("Select the list of email addresses.", "Obtain Range Object", Type:=8)
fNameString = RangeToArray(fNameStringRange)
lNameString = RangeToArray(lNameStringRange)
sEmailString = RangeToArray(sEmailStringRange)
nPointVal = InputBox("Please enter a point value for this event")
sEventName = InputBox("Please enter the name of the event.")

lEvent = NextEmptyColumn(Range("A1"))
Set sE = Range("A1").Offset(0, lEvent)
sE.Value = sEventName
' sEventPos = sE.Offset(0, lEvent)

If fNameString <> False And lNameString <> False Then

    For i = LBound(fNameString) To UBound(fNameString)

        fNameString(i) = Trim(fNameString(i)) ' Trim off leading and trailing whitespace.
        lNameString(i) = Trim(lNameString(i)) ' Trim off leading and trailing whitespace.

        Set c = fName.Find(fNameString(i), LookIn:=xlValues, LookAt:=xlWhole)
        Set d = lName.Find(lNameString(i), LookIn:=xlValues, LookAt:=xlWhole)

        If Not c Is Nothing And Not d Is Nothing Then

                Set p = c.Offset(0, lEvent)
                p.Value = nPointVal


        ElseIf c Is Nothing And d Is Nothing Or c Is Nothing And Not d Is Nothing _
         Or Not c Is Nothing And d Is Nothing Then

            Set c = fName.End(xlDown).Offset(1, 0)
            c.Value = fNameString(i)
            Set d = lName.End(xlDown).Offset(1, 0)
            d.Value = lNameString(i)
            Set e = sEmail.End(xlDown).Offset(1, 0)
            e.Value = sEmailString(i)
            Set p = fName.End(xlDown).Offset(0, lEvent)
            p.Value = nPointVal

            Dim s As Range ' Our summation range
            Set s = Range(c.Offset(0, 4), c.Offset(0, 4))
            Dim rD As Integer
            rD = Application.WorksheetFunction.RoundDown((s.Address / 250), 0)

            c.Offset(0, 3).Formula = "=((" & s.Address & "/250)-ROUNDDOWN((" & s.Address & "/250),0))*250"

            Set s = Range(c.Offset(0, 5), c.Offset(0, 42))
            c.Offset(0, 4).Formula = "=SUM(" & s.Address & ")"
            c.Offset(0, 5).Value = 0

        End If

    Next

End If

End Sub
14
  • It's not clear exactly what you're doing, and you haven't posted enough code for us to figure it out, so it's going to be difficult for you to get useful answers to your question. Commented Sep 25, 2016 at 23:35
  • Full code added and additional information provided. Commented Sep 25, 2016 at 23:48
  • have you tried debugging with breakpoints? Is your code passing the If tests where expected? Commented Sep 26, 2016 at 0:08
  • I'm not sure how to use breakpoints. I read about them, but I still don't understand how to use them. Commented Sep 26, 2016 at 0:49
  • 2
    You need to use Set fNameStringRange = Application.InputBox( ... , Type:=8) Commented Sep 26, 2016 at 1:44

1 Answer 1

1

Here is a few modifications as requested. Looks like the biggest issue was not so much the array but you weren't clear c and d which meant the test was not moving to the else condition. I cant be sure of that cause I had to play with a few things, make assumptions and make data. But I hope this gets you on the right track now.

Sub addEvent()

On Error Resume Next

Dim fNameString As Variant
Dim lNameString As Variant
Dim sEmailString As Variant
Dim nPointVal As Integer
Dim sEventName As String
Dim n As Integer, r As Long, c As Range, d As Range, e As Range, p As Range, sE As Range
Dim fName As Range, lName As Range, sEmail As Range, z As Range
Dim lEvent As Integer
Set fName = ActiveSheet.Range("FirstName")
Set lName = ActiveSheet.Range("LastName")
Set sEmail = ActiveSheet.Range("eMailAddr")


fNameString = Application.InputBox("Select the list of first names.", "Obtain Range Object", Type:=8)
lNameString = Application.InputBox("Select the list of last names.", "Obtain Range Object", Type:=8)
sEmailString = Application.InputBox("Select the list of email addresses.", "Obtain Range Object", Type:=8)
nPointVal = InputBox("Please enter a point value for this event")
sEventName = InputBox("Please enter the name of the event.")

lEvent = NextEmptyColumn(Range("A1"))
Set sE = Range("A1").Offset(0, lEvent)
sE.Value = sEventName
' sEventPos = sE.Offset(0, lEvent)

If fNameString <> False And lNameString <> False Then

    For i = LBound(fNameString) To UBound(fNameString)
        'clear the range variables to ensure the tests are correctly applied
        'was previously retaining old value and not progressing to second condition
        Set c = Nothing: Set d = Nothing: Set p = Nothing

        fNameString(i, 1) = Trim(fNameString(i, 1)) ' Trim off leading and trailing whitespace.
        lNameString(1, 1) = Trim(lNameString(i, 1)) ' Trim off leading and trailing whitespace.
        Set c = fName.Find(fNameString(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
        Set d = lName.Find(lNameString(i, 1), LookIn:=xlValues, LookAt:=xlWhole)

        If Not c Is Nothing And Not d Is Nothing Then
            Set p = c.Offset(0, lEvent)
            p.Value = nPointVal
        ElseIf c Is Nothing Or d Is Nothing Then
            Set c = fName.End(xlDown).Offset(1, 0)
            c.Value = fNameString(i, 1)
            Set d = lName.End(xlDown).Offset(1, 0)
            d.Value = lNameString(i, 1)
            Set e = sEmail.End(xlDown).Offset(1, 0)
            e.Value = sEmailString(i, 1)
            Set p = fName.End(xlDown).Offset(0, lEvent)
            p.Value = nPointVal

            Dim s As Range ' Our summation range
            Set s = Range(c.Offset(0, 4), c.Offset(0, 4))
            Dim rD As Integer
            rD = Application.WorksheetFunction.RoundDown((s.Address / 250), 0)
            c.Offset(0, 3).Formula = "=((" & s.Address & "/250)-ROUNDDOWN((" & s.Address & "/250),0))*250"
            Set s = Range(c.Offset(0, 5), c.Offset(0, 42))
            c.Offset(0, 4).Formula = "=SUM(" & s.Address & ")"
            c.Offset(0, 5).Value = 0
        End If
    Next
End If

End Sub
Sign up to request clarification or add additional context in comments.

1 Comment

Wow, I didn't even think about the variables c and d needing to clear every time it iterates through. Well, it works as intended now. Thanks a ton Captain Grumpy!!!

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.