Oh great, it works perfectly!!! Thank you very much for your prompt
advice!!!
I really appreciate your code and I will use this for my VBA learning.

Ensuring the data only be appended to sheet3, I add one more line
Worksheets("Sheet3").Select
before your code
With Sheets("Sheet3")
'format column C for correct month format

FYI, the 4/1/09 problem is due to my own mistake. In both sheet1
and sheet2, after formatting the cell from showing "Apr-09" to
"1-Apr-09", the code works fine and meets all my requirements.

Many Thanks!!!
Ivan

I must say big "thank you" to you for your help. It

"joel" wrote in message
...

I fixed the problem that the code wasn't getting data from both sheets
and the Date problem wrong in sheet 3. I also fixed some other minor
problems
you didn't report.

I can't duplicate the 4/1/09 problem getting an error that it can't
find the 1-Apr-09. You either have a blank in the cell or you have
single quote in thecell which makes it s string. To solve this problem
I change in the Find method from xlwhole to xlPart.

Sub GetMonthlyData()

DataSheets = Array("Sheet1", "Sheet2")

PromptStr = "Enter Date or nothing to copy all dates"
Do
MyDate = InputBox(Title:="get Date", _
Prompt:=PromptStr)
If MyDate = "" Then
CopyAll = True
Exit Do
Else
If IsDate(MyDate) Then
MyDate = DateValue(MyDate)

For Each Sht In DataSheets
With Sheets(Sht)
FirstDate = .Range("C1")
LastDate = .Range("N1")
If MyDate = FirstDate And _
MyDate <= LastDate Then
CopyAll = False

Exit Do
End If
End With
Next Sht
End If
End If

PromptStr = "Invalid Date" & vbCrLf & _
"Enter Date or nothing to copy all dates"

Loop While 1 'loop forever

With Sheets("Sheet3")
'format column C for correct month format
Columns("C").NumberFormat = "mmm-yy"

Columns("D").NumberFormat = "0,000"

If CopyAll = True Then
'erase all data
LastRowSht3 = .Range("A" & Rows.Count).End(xlUp).Row
If LastRowSht3 < 1 Then
Rows("2:" & LastRowSht3).Delete
End If
End If

LastRowSht3 = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRowSht3 + 1

End With

If CopyAll = True Then
For Each Sht In DataSheets
With Sheets(Sht)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
Name = .Range("A" & RowCount)
PayCAT = .Range("B" & RowCount)

For ColCount = 3 To 14
Amount = .Cells(RowCount, ColCount)
If Amount < 0 Then
MyDate = .Cells(1, ColCount)
With Sheets("Sheet3")
Range("A" & NewRow) = Name
Range("B" & NewRow) = PayCAT
Range("C" & NewRow) = MyDate
Range("D" & NewRow) = Amount
NewRow = NewRow + 1
End With
End If
Next ColCount
Next RowCount
End With
Next Sht

Else
For Each Sht In DataSheets

With Sheets(Sht)
'get column of date
StrDate = Format(MyDate, "d-mmm-yy")
Set c = .Rows(1).Find(what:=StrDate, _
LookIn:=xlValues, lookat:=xlpart)
If c Is Nothing Then
MsgBox ("Date Error - Can't find date : " & StrDate)
Else

LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
Amount = .Cells(RowCount, c.Column)
If Amount < 0 Then

Name = .Range("A" & RowCount)
PayCAT = .Range("B" & RowCount)
MyDate = .Cells(1, c.Column)

With Sheets("Sheet3")
Range("A" & NewRow) = Name
Range("B" & NewRow) = PayCAT
Range("C" & NewRow) = MyDate
Range("D" & NewRow) = Amount
NewRow = NewRow + 1
End With
End If
Next RowCount
End If
End With
Next Sht
End If

End Sub

--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=165248

Microsoft Office Help