Populating UserForm TextBoxes from ListBox results

[AGrace]

Hello all,

Ok, so I have this userform:

Ignoring the top section which is in good working order: The listbox you can see in the Custom Summary Filter section of the image is populated from a list of dates on sheet2 ("Data" - range G3-G34). This list was in-turn extracted from sheet3 ("Import" - range A2-A3600), where there are thousands of daily entries which make up a month's worth of sales. Sheet3 also has two other columns I'm interested in. Column E (UserID's), and I (Transaction type).

What I'd like to do is select a date using the ListBox, hit the "Update Filter" button and see how many unique Users purchases there are on that date, and how many transactions were "Direct payments" or "offerwall payments".

In addition, it needs to allow the user to select more than one date as well to give stats on a weekly or a weekend of sales.

The "Direct payments" and "Offerwall payments" need to basically look at the date(s) selected in the list box, find and match the date(s) on Sheet3(Import) column A (range is A2:A3600) offset by 8 and then count all the "DirectPayment" and "Offer" entries for the date(s) selected into the respective TextBoxes on the userform.

The UserID's however need to do a similar function except instead of counting the total user's listed on the date(s), count the number of "Unique Users" for the date(s) selected.

Any ideas, suggestions or guidance on how to implement this would be fantastic!

Thank you in advance.

Adam

 

[Domenic]

Try...

Private Sub CommandButton1_Click()
    Dim SelDates() As Date
    Dim UniqueID As New Collection
    Dim Cnt As Long
    Dim i As Long
    Dim DirPayCount As Long
    Dim OfferCount As Long
    Dim x As Variant
    Cnt = 0
    With Me.ListBox1 [COLOR="DarkGreen"]'Change the name of the control accordingly[/COLOR]
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ReDim Preserve SelDates(0 To Cnt)
                SelDates(Cnt) = .List(i)
                Cnt = Cnt + 1
            End If
        Next i
    End With
    If Cnt > 0 Then
        DirPayCount = 0
        OfferCount = 0
        On Error Resume Next
        With Worksheets("Import")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For i = 2 To LastRow
                x = Application.Match(.Cells(i, "A").Value, SelDates, 0)
                If Not IsError(x) Then
                    UniqueID.Add .Cells(i, "E").Value, CStr(.Cells(i, "E").Value)
                    If UCase(.Cells(i, "I").Value) = "DIRECTPAYMENT" Then
                        DirPayCount = DirPayCount + 1
                    ElseIf UCase(.Cells(i, "I").Value) = "OFFER" Then
                        OfferCount = OfferCount + 1
                    End If
                End If
            Next i
        End With
        On Error GoTo 0
        Me.TextBox1.Text = DirPayCount [COLOR="DarkGreen"]'Change the name of the control accordingly[/COLOR]
        Me.TextBox2.Text = OfferCount [COLOR="DarkGreen"]'Change the name of the control accordingly[/COLOR]
        Me.TextBox3.Text = UniqueID.Count [COLOR="DarkGreen"]'Change the name of the control accordingly[/COLOR]
    Else
        MsgBox "Please select one or more dates...", vbExclamation
    End If
End Sub

 

[AGrace]

Thanks Domenic for that code example, and thanks for taking the time to write it.

It's functioning with my amendments (names etc), but isn't giving back any data for any date except 11/11/2010. I guess the list box dates aren't matching up with the dates on the "Import" sheet.

Also, the only data that's feeding back on this date is the Unique UserID's. The payment types aren't being fed back.

I have a format macro to change the dates on the sheet to mm/dd/yyyy but for some reason they always display dd/mm/yyyy (in the listbox for example).

Any thought's on why none of the Direct or Offer payments are being counted?

Thanks,

Adam

 

[Domenic]

Try replacing...

Dim SelDates() As Date

with

Dim SelDates() As String

and

SelDates(Cnt) = .List(i)

with

SelDates(Cnt) = Format(.List(i), "mm/dd/yy")

and

x = Application.Match(.Cells(i, "A").Value, SelDates, 0)

with

x = Application.Match(Format(.Cells(i, "A").Value, "mm/dd/yy"), SelDates, 0)

 

[AGrace]

ignore me... amended the wrong section.

Fantastic. It's logging all the Unique UserID's.. just not the DirectPayment or Offer counts.

Adam

 

[Domenic]

Can you please confirm the actual values you have in Column I? Are they "DirectPayment" and "Offer"?

 

[AGrace]

Indeed, those are the values.

 

[Domenic]

Maybe the cells in Column I contain extra spaces. Does it help if you replace...

If UCase(.Cells(i, "I").Value) = "DIRECTPAYMENT" Then
    DirPayCount = DirPayCount + 1
ElseIf UCase(.Cells(i, "I").Value) = "OFFER" Then
    OfferCount = OfferCount + 1
End If

with

If UCase(Trim(.Cells(i, "I").Value)) = "DIRECTPAYMENT" Then
    DirPayCount = DirPayCount + 1
ElseIf UCase(Trim(.Cells(i, "I").Value)) = "OFFER" Then
    OfferCount = OfferCount + 1
End If

?

 

[AGrace]

Maybe the cells in Column I contain extra spaces. Does it help if you replace...

If UCase(.Cells(i, "I").Value) = "DIRECTPAYMENT" Then
    DirPayCount = DirPayCount + 1
ElseIf UCase(.Cells(i, "I").Value) = "OFFER" Then
    OfferCount = OfferCount + 1
End If

with

If UCase(Trim(.Cells(i, "I").Value)) = "DIRECTPAYMENT" Then
    DirPayCount = DirPayCount + 1
ElseIf UCase(Trim(.Cells(i, "I").Value)) = "OFFER" Then
    OfferCount = OfferCount + 1
End If

?

My friend, you're a star!

Thank you so very much!

 

[Domenic]

You're very welcome! Thanks for the feedback!