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

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" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> 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

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" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> 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

Thank you for your detailed explanation. I really want to develop
better programming practices to produce efficient code, especially
when the data is getting bigger and bigger.

I follow your advice and remove the select code. When the sheet3
is the active sheet, there is no problem. However, if any other sheet
is the active sheet, then the result will overwrite the source data.

I am not sure if I miss anything?

Many thanks!!!
Ivan Hung

"joel" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> 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
>

Joel, Did you forget the dots?


--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"joel" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> The code won't over-write anything on the source sheet. the writing is
> done with this code
>
> With Sheets("Sheet3")
> Range("A" & NewRow) = Name
> Range("B" & NewRow) = PayCAT
> Range("C" & NewRow) = MyDate
> Range("D" & NewRow) = Amount
> NewRow = NewRow + 1
> End With
>
>
> The periods at the before the RANGE objects are part of the With
> Statement above the section. The code really says the following
>
>
> Sheets("Sheet3").Range("A" & NewRow) = Name
> Sheets("Sheet3").Range("B" & NewRow) = PayCAT
> Sheets("Sheet3").Range("C" & NewRow) = MyDate
> Sheets("Sheet3").Range("D" & NewRow) = Amount
>
>
> --
> joel
> ------------------------------------------------------------------------
> joel's Profile: 229
> View this thread:
> http://www.thecodecage.com/forumz/sh...d.php?t=165248
>
> Microsoft Office Help
>

joel,

Thanks again.
I have tried many times to execute the code in sheet1 or sheet2 in vain,
even though I add dot preceding to .Range("A" & NewRow).........

Take sheet2 for example, after executing, the code, source data except
the heading are cleared and appended to the same sheet2 starting from
row 30.

I can't figure out where goes wrong with the code. Any idea?

Ivan

"joel" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> The code won't over-write anything on the source sheet. the writing is
> done with this code
>
> With Sheets("Sheet3")
> Range("A" & NewRow) = Name
> Range("B" & NewRow) = PayCAT
> Range("C" & NewRow) = MyDate
> Range("D" & NewRow) = Amount
> NewRow = NewRow + 1
> End With
>
>
> The periods at the before the RANGE objects are part of the With
> Statement above the section. The code really says the following
>
>
> Sheets("Sheet3").Range("A" & NewRow) = Name
> Sheets("Sheet3").Range("B" & NewRow) = PayCAT
> Sheets("Sheet3").Range("C" & NewRow) = MyDate
> Sheets("Sheet3").Range("D" & NewRow) = Amount
>
>
> --
> joel
> ------------------------------------------------------------------------
> joel's Profile: 229
> View this thread:
> http://www.thecodecage.com/forumz/sh...d.php?t=165248
>
> Microsoft Office Help
>

joel

Finally, the code works flawlessly. As told, I copy the code again from the
below URL and now no more over-write issue.

I really really appreciated your help and step-by-step guidance.

Thank you very much!
Ivan

"joel" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> Don: All the code that I posted had the dots. for some reason some of
> the replies are missing the dots. I can't see what I did wrong that the
> code is reading and writing to sheet2 without the select.
>
> Ivan: check you code and make sure the al the Methods below start with
> a period:
>
> Range
> Columns
> Cells
>
>
> Ivan if you are not getting the code from the CodeCage try this URL
>
> http://www.thecodecage.com/forumz/ne...reply&p=597160
>
>
> --
> joel
> ------------------------------------------------------------------------
> joel's Profile: 229
> View this thread:
> http://www.thecodecage.com/forumz/sh...d.php?t=165248
>
> Microsoft Office Help

I did this and it tested fine. Format your sheet 3.
I can send the workbook,if desired.

Sub GetDataSAS()
Application.ScreenUpdating = False
Set cs = Sheets("sheet1")
Set ds = Sheets("sheet3")
getdate:
ans = InputBox("Enter a proper date: ex: 7/1/2009 " & vbCr & " or touch the
enter key for ALL")
On Error GoTo doall
Set mycol = cs.Rows(1).Find(what:=CDate(ans), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
_
MatchCase:=False)
If mycol Is Nothing Then GoTo getdate
doall:
If ans = "" Then
mc = 0
Else
mc = mycol.Column
End If
'MsgBox mc
If mc = 0 Then
dlr = ds.Cells(Rows.Count, 1).End(xlUp).Row
ds.Rows(2).Resize(dlr).Delete
x = 3: y = cs.Cells(1, Columns.Count).End(xlToLeft).Column
Else
x = mc: y = mc
End If

For Each ws In Array("sheet1", "sheet2")
Set ss = Sheets(ws)
For j = 2 To ss.Cells(Rows.Count, 1).End(xlUp).Row
For i = x To y
dlr = ds.Cells(Rows.Count, 1).End(xlUp).Row + 1
If ss.Cells(j, i) > 0 Then
ds.Cells(dlr, 1).Value = ss.Cells(j, 1).Value
ds.Cells(dlr, 2).Value = ss.Cells(j, 2).Value
ds.Cells(dlr, 3).Value = ss.Cells(1, i).Value
ds.Cells(dlr, 4).Value = ss.Cells(j, i).Value

End If
Next i
Next j
Next ws
dlr = ds.Cells(Rows.Count, 1).End(xlUp).Row
ds.Range("A1" & dlr).Sort _
Key1:=ds.Range("C2"), Order1:=xlAscending, _
Key2:=ds.Range("B2"), Order2:=xlAscending, _
Key3:=ds.Range("A2"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
Application.ScreenUpdating = True
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"joel" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> Don: All the code that I posted had the dots. for some reason some of
> the replies are missing the dots. I can't see what I did wrong that the
> code is reading and writing to sheet2 without the select.
>
> Ivan: check you code and make sure the al the Methods below start with
> a period:
>
> Range
> Columns
> Cells
>
>
> Ivan if you are not getting the code from the CodeCage try this URL
>
> http://www.thecodecage.com/forumz/ne...reply&p=597160
>
>
> --
> joel
> ------------------------------------------------------------------------
> joel's Profile: 229
> View this thread:
> http://www.thecodecage.com/forumz/sh...d.php?t=165248
>
> Microsoft Office Help
>

Wonderful!...thank you both...you both worked!

Ivan

"Don Guillett" <(E-Mail Removed)> wrote in message
news:%23V$(E-Mail Removed)...
>I did this and it tested fine. Format your sheet 3.
> I can send the workbook,if desired.
>
> Sub GetDataSAS()
> Application.ScreenUpdating = False
> Set cs = Sheets("sheet1")
> Set ds = Sheets("sheet3")
> getdate:
> ans = InputBox("Enter a proper date: ex: 7/1/2009 " & vbCr & " or touch
> the enter key for ALL")
> On Error GoTo doall
> Set mycol = cs.Rows(1).Find(what:=CDate(ans), LookIn:=xlFormulas, _
> LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
> _
> MatchCase:=False)
> If mycol Is Nothing Then GoTo getdate
> doall:
> If ans = "" Then
> mc = 0
> Else
> mc = mycol.Column
> End If
> 'MsgBox mc
> If mc = 0 Then
> dlr = ds.Cells(Rows.Count, 1).End(xlUp).Row
> ds.Rows(2).Resize(dlr).Delete
> x = 3: y = cs.Cells(1, Columns.Count).End(xlToLeft).Column
> Else
> x = mc: y = mc
> End If
>
> For Each ws In Array("sheet1", "sheet2")
> Set ss = Sheets(ws)
> For j = 2 To ss.Cells(Rows.Count, 1).End(xlUp).Row
> For i = x To y
> dlr = ds.Cells(Rows.Count, 1).End(xlUp).Row + 1
> If ss.Cells(j, i) > 0 Then
> ds.Cells(dlr, 1).Value = ss.Cells(j, 1).Value
> ds.Cells(dlr, 2).Value = ss.Cells(j, 2).Value
> ds.Cells(dlr, 3).Value = ss.Cells(1, i).Value
> ds.Cells(dlr, 4).Value = ss.Cells(j, i).Value
>
> End If
> Next i
> Next j
> Next ws
> dlr = ds.Cells(Rows.Count, 1).End(xlUp).Row
> ds.Range("A1" & dlr).Sort _
> Key1:=ds.Range("C2"), Order1:=xlAscending, _
> Key2:=ds.Range("B2"), Order2:=xlAscending, _
> Key3:=ds.Range("A2"), Order3:=xlAscending, _
> Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
> Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
> DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
> Application.ScreenUpdating = True
> End Sub
>
> --
> Don Guillett
> Microsoft MVP Excel
> SalesAid Software
> (E-Mail Removed)
> "joel" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
>>
>> Don: All the code that I posted had the dots. for some reason some of
>> the replies are missing the dots. I can't see what I did wrong that the
>> code is reading and writing to sheet2 without the select.
>>
>> Ivan: check you code and make sure the al the Methods below start with
>> a period:
>>
>> Range
>> Columns
>> Cells
>>
>>
>> Ivan if you are not getting the code from the CodeCage try this URL
>>
>> http://www.thecodecage.com/forumz/ne...reply&p=597160
>>
>>
>> --
>> joel
>> ------------------------------------------------------------------------
>> joel's Profile: 229
>> View this thread:
>> http://www.thecodecage.com/forumz/sh...d.php?t=165248
>>
>> Microsoft Office Help