I'm trying to implement a userform into my macro. I want it to at some point in time, ask the user which date it would like to select. I devised a plan to pull a non-duped date (A:A). I successfully got a list of unduped entries by having excel copy column A from all the sheets and putting them in one sheet (DateData). I then put code to:
Sub FormDate()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
' The items are in A1:A105
Sheets("DateData").Select
Set AllCells = Range("A1:A105")
' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell
' Resume normal error handling
On Error GoTo 0
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
frmDateSelect.cbDate.AddItem Item
Next Item
' Show the UserForm
frmDateSelect.Show
End Sub
After the userform selection, it would then pass to:
Sub DateSelect()
Range("A1").Select
Selection.AutoFilter
On Error GoTo e
Application.ScreenUpdating = False
Dim feRange As Range, ceRange As Range, peRange As Range
Set feRange = Range(("A1"), Range("A65536").End(xlUp))
Set ceRange = Range(("A2"), Range("A65536").End(xlUp))
Set peRange = Worksheets("Trades").Range("A65536").End(xlUp).Offset(1, 0)
feRange.AutoFilter Field:=1, Criteria1:=CurrentDate
ceRange.SpecialCells(xlCellTypeVisible).Copy peRange
Set feRange = Nothing
Set ceRange = Nothing
Set peRange = Nothing
Application.ScreenUpdating = True
Exit Sub
e:
MsgBox "No ''Dates'' data in column A.", 64, "Nothing to Copy"
End Sub
The problem lies here:
feRange.AutoFilter Field:=1, Criteria1:=CurrentDate
Will excel know that I'm passing this. I implemented this code and it gave me wierd results, It gave me the 2nd row of data from each sheet. I have no idea what is happening. Please help! Thanks in advance!!!
Sub FormDate()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
' The items are in A1:A105
Sheets("DateData").Select
Set AllCells = Range("A1:A105")
' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell
' Resume normal error handling
On Error GoTo 0
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
frmDateSelect.cbDate.AddItem Item
Next Item
' Show the UserForm
frmDateSelect.Show
End Sub
After the userform selection, it would then pass to:
Sub DateSelect()
Range("A1").Select
Selection.AutoFilter
On Error GoTo e
Application.ScreenUpdating = False
Dim feRange As Range, ceRange As Range, peRange As Range
Set feRange = Range(("A1"), Range("A65536").End(xlUp))
Set ceRange = Range(("A2"), Range("A65536").End(xlUp))
Set peRange = Worksheets("Trades").Range("A65536").End(xlUp).Offset(1, 0)
feRange.AutoFilter Field:=1, Criteria1:=CurrentDate
ceRange.SpecialCells(xlCellTypeVisible).Copy peRange
Set feRange = Nothing
Set ceRange = Nothing
Set peRange = Nothing
Application.ScreenUpdating = True
Exit Sub
e:
MsgBox "No ''Dates'' data in column A.", 64, "Nothing to Copy"
End Sub
The problem lies here:
feRange.AutoFilter Field:=1, Criteria1:=CurrentDate
Will excel know that I'm passing this. I implemented this code and it gave me wierd results, It gave me the 2nd row of data from each sheet. I have no idea what is happening. Please help! Thanks in advance!!!
