Hi,
I am learning VBA Excel and have attempted this, but can't seem to get it to
work together.

I have sheet1, sheet2 and sheet3 in the same workbook. I would like to
append data (value only) from sheet1 and sheet2 and append to the last blank
row on sheet3. I have the following information on the sheet1 and sheet2,
what I would like to have is sheet3. Can someone help me out?

Sheet1
A B C D E F
G H I J K L M
N
Name PayCAT 1-Apr-09 1-May-09 1-Jun-09 1-Jul-09 1-Aug-09 1-Sep-09 1-Oct-09
1-Nov-09 1-Dec-09 1-Jan-10 1-Feb-10 1-Mar-10
Peter Base 10,000 10,000 10,000 10,000 10,000 10,000
10,000 10,000 10,000 11,000 11,000 11,000
John Base 12,000 12,000 12,000 12,000 12,000 12,000
12,000 12,000 12,000 13,000 13,000 13,000

Sheet2
A B C D E F
G H I J K L M
N
Name PayCAT 1-Apr-09 1-May-09 1-Jun-09 1-Jul-09 1-Aug-09 1-Sep-09 1-Oct-09
1-Nov-09 1-Dec-09 1-Jan-10 1-Feb-10 1-Mar-10
Peter Bonus 0 18,000 0 0 0
0 0 0 10,000 0 0 0
John Bonus 0 20,000 0 0 0
0 0 0 12,000 0 0 0

Sheet3
A B C D
Name PayCAT Month Amount
Peter Base Apr-09 10,000
John Base Apr-09 12,000
Peter Base May-09 10,000
John Base May-09 12,000
Peter Bonus May-09 18,000
John Bonus May-09 20,000
Peter Base Jun-09 10,000
John Base Jun-09 12,000
Peter Base Jul-09 10,000
John Base Jul-09 12,000
Peter Base Aug-09 10,000
John Base Aug-09 12,000
Peter Base Sep-09 10,000
John Base Sep-09 12,000
Peter Base Oct-09 10,000
John Base Oct-09 12,000
Peter Base Nov-09 10,000
John Base Nov-09 12,000
Peter Base Dec-09 10,000
Peter Bonus Dec-09 10,000
John Base Dec-09 12,000
John Bonus Dec-09 12,000
Peter Base Jan-10 11,000
John Base Jan-10 13,000
Peter Base Feb-10 11,000
John Base Feb-10 13,000
Peter Base Mar-10 11,000
John Base Mar-10 13,000

I would like the user to be prompted with the dialog box for current month
in the format "dd-mmm-yy", if the user input is invalid (outside the date
range on sheet1), then prompt user again, if user input is blank, then clear
data on sheet3 and copy 12 months data from sheet1/sheet2 and append to the
last blank row on sheet3, otherwise only copy the current month data from
sheet1/sheet2 and append to the last blank row on sheet3.

In addition, if the amount on sheet1 or sheet2 is zero, no record for the
month will be appended to sheet3.

Any response would be greatly appreciated!

Many thanks,
Ivan

I think I met all requirements



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
SourceSht = Sht
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
NewRow = 2
Else
LastRowSht3 = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End If
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)
MyDate = .Range("C" & RowCount)

For ColCount = 3 To 14
Amount = .Cells(RowCount, ColCount)
If Amount < 0 Then

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
With Sheets(Sht)
'get column of date
StrDate = Format(MyDate, "d-mmm-yy")
Set c = .Rows(1).Find(what:=StrDate, _
LookIn:=xlValues, lookat:=xlWhole)
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 = .Range("C" & RowCount)

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
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

Hi, joel

Thank you for your prompt help.

I have tried your codes and, when prompted, I input blank and
click OK. The codes are great and meets most of my expectation
except column "month".

Name PayCAT Month Amount
Peter Base 10000 10,000
Peter Base 10000 10,000
Peter Base 10000 10,000
Peter Base 10000 10,000
Peter Base 10000 10,000
Peter Base 10000 10,000
Peter Base 10000 10,000
Peter Base 10000 10,000
Peter Base 10000 10,000
Peter Base 10000 11,000
Peter Base 10000 11,000
Peter Base 10000 11,000
John Base 12000 12,000
John Base 12000 12,000
John Base 12000 12,000
John Base 12000 12,000
John Base 12000 12,000
John Base 12000 12,000
John Base 12000 12,000
John Base 12000 12,000
John Base 12000 12,000
John Base 12000 13,000
John Base 12000 13,000
John Base 12000 13,000
Peter Bonus 0 18,000
Peter Bonus 0 10,000
John Bonus 0 20,000
John Bonus 0 12,000

Besides, when prompt for "Enter Date or nothing to copy all dates",
I input 4/1/2009 and click OK, then an error message pops up
"Date error - can't find date : 1-Apr-2009" and then no data are
appended to sheet3.

FYI, I use Office 2003 and Windows XP with English (US) formats
in the Region and Language.

Can you please let me know how to change the code for the above?

Many thanks to your advice.

Ivan

"joel" wrote in message
...

I think I met all requirements



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
SourceSht = Sht
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
NewRow = 2
Else
LastRowSht3 = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End If
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)
MyDate = .Range("C" & RowCount)

For ColCount = 3 To 14
Amount = .Cells(RowCount, ColCount)
If Amount < 0 Then

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
With Sheets(Sht)
'get column of date
StrDate = Format(MyDate, "d-mmm-yy")
Set c = .Rows(1).Find(what:=StrDate, _
LookIn:=xlValues, lookat:=xlWhole)
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 = .Range("C" & RowCount)

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
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

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

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

There is no reason to perform the select since the WITH and the periods
before all the object will automatically write to sheet 3. the Select
will actually slow down the code because the macro will actually select
the sheet and then the sheet will go through a refresh and a recalculate
which takes time.

The macro recorder uses bad programming practices producing inefficant
code. I often use the macro recorder because I don't have all the
syntac memorized, but always rewrite the recorded macros.


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

Microsoft Office Help