PDA

View Full Version : Solved: Copy current data to a new sheet....



Papadopoulos
12-13-2010, 12:09 PM
I have an application that collects data simply appending the new data at the end...
I need to take this data, allow the user to select a month and a year, and have my macro copy all the relevant data to a new sheet.
Attached is sample of the data and the start of my user form.
the date that I am looking at is always in column D. The format is text and the date is formatted as m/d/y. I just want to compare what the user has entered to the m and y portions. Regular expressions? is this easier if the Date column is formatted as "date" instead of "text"?

Thanks in advance for any guidance.
David

Bob Phillips
12-14-2010, 01:30 AM
Private Sub CommandButton1_Click()
mO = TextBox1.Value
yr = TextBox2.Value
Call CopyData(Val(mO), Val(yr))
Unload Me
End Sub

Function CopyData(mth As Long, yr As Long)
Const FORMULA_TEST As String = _
"=AND(MONTH(D2)=<month>,YEAR(D2)=<year>)"
Dim rng As Range
Dim airea As Range
Dim Lastrow As Long
Dim Nextrow As Long

With Worksheets("Raw Import")

.Rows(1).Insert
.Range("O1").Value = "Tmp"
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("O2").Resize(Lastrow - 1).Formula = Replace(Replace(FORMULA_TEST, _
"<month>", mth), _
"<year>", yr)
Set rng = .Range("A1").Resize(Lastrow, 15)
rng.AutoFilter field:=15, Criteria1:="=TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then

Nextrow = 1
For Each airea In rng.Areas

airea.EntireRow.Copy Worksheets(2).Cells(Nextrow, "A")
Nextrow = Nextrow + airea.Rows.Count
Next airea
Worksheets(2).Columns(15).Delete
Worksheets(2).Rows(1).Delete
End If
.Columns(15).Delete
.Rows(1).Delete
End With

End Function

Papadopoulos
12-14-2010, 12:39 PM
You know what's better than having a solution to a problem...
Being able to learn form that solution!

You Rock!
:thumb