View Full Version : Creating a report

11-09-2011, 01:28 PM
I have an excel file with lots of different brokers in column A. The broker may appear many different times. I am trying to generate reports based on each broker. But each report differs. So is there a way to write a macro that has a pop up box that allows you to select which broker you want? And then extracts all the data for that broker into a new excel sheet? After taht data is extracted, i woud like to have another pop up box come up that allows you to type in a date range (Start Date, End Date) and that will further select the data for that broker in that date range.

Brokers are listed in column A, and dates are listed in column D. And when data is extracted, i would like the entire row to be extracted (which goes from A to P)

Thanks for the help!

11-09-2011, 02:00 PM
Can you post a book with sample data?

11-09-2011, 02:21 PM
This relates to my creating a report post form earlier. I have attached the sample data that was requested.


11-09-2011, 04:13 PM
Give this a try

11-10-2011, 07:25 AM
I dont see anything to try?

11-10-2011, 09:39 AM
There is an attached file. If you don't see it, what browser are you using?

11-10-2011, 09:41 AM
i opened it but it just shows the home page for VBA. I am using Internet Explorer

11-10-2011, 12:58 PM
This is a new one on me. I've opened test.xls in 2 locations and I can't replicate your problem. Do you have the same issue with other attachments.

11-10-2011, 01:03 PM
'Place all code in the Userform
Option Explicit
Dim FArray()
Dim DataList As Range
Dim MyList As String

Private Sub UserForm_Initialize()
Dim Found As Long, i As Long
Dim cel As Range
With Sheets("Trades")
Set DataList = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
ReDim FArray(DataList.SpecialCells(xlCellTypeConstants).Count)
i = -1
For Each cel In DataList.SpecialCells(xlCellTypeConstants)
On Error Resume Next
Found = Application.WorksheetFunction.Match(CStr(cel), FArray, 0)
If Found > 0 Then GoTo Exists
i = i + 1
FArray(i) = cel
Found = 0
ReDim Preserve FArray(i)
Call BubbleSort(FArray)
ComboBox1.ListRows = i + 1
ComboBox1.List() = FArray
End Sub
Private Sub ComboBox1_AfterUpdate()
Dim MyAdd As String
Dim Found As Long
On Error Resume Next
Found = Application.WorksheetFunction.Match(ComboBox1, FArray, 0)
If Found > 0 Then
DataList.End(xlDown).Offset(1) = ComboBox1
Set DataList = Union(DataList, DataList.End(xlDown))
MyAdd = "=" & ActiveSheet.Name & "!" & DataList.Address
ActiveWorkbook.Names.Add Name:=MyList, _
End If
End Sub
Private Sub CommandButton1_Click()
End Sub
Private Sub CommandButton2_Click()
End Sub

Sub BubbleSort(MyArray As Variant)
Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim j As Integer
Dim Temp As String
Dim List As String
First = LBound(MyArray)
Last = UBound(MyArray)
For i = First To Last - 1
For j = i + 1 To Last
If MyArray(i) > MyArray(j) Then
Temp = MyArray(j)
MyArray(j) = MyArray(i)
MyArray(i) = Temp
End If
Next j
Next i
End Sub
Sub FilterCo()
Dim r As Range
Application.ScreenUpdating = False
With Sheets("Trades")
Set r = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 16)
End With
r.AutoFilter Field:=1, Criteria1:=ComboBox1
r.SpecialCells(xlCellTypeVisible).Copy Sheets(2).Cells(1, 1)
With Sheets(2)
End With
Application.ScreenUpdating = True
End Sub
Sub FilterDates()
Dim r As Range, d1, d2
Application.ScreenUpdating = False
With Sheets(2)
Set r = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 16)
d1 = Format(DateValue(TextBox1), .Range("$D$2").NumberFormat)
d2 = Format(DateValue(TextBox2), .Range("$D$2").NumberFormat)
End With
r.AutoFilter Field:=4, Criteria1:=">=" & d1, Operator:=xlAnd, Criteria2:="<=" & d2
Application.ScreenUpdating = True
End Sub

Great, i see this is what you used..things work so far!