Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value, "dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col + 2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw, 4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,
"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col +
2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw, 4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah

Thanks for reply
I want if there is any change than in data tahn copies new data to the same
position other wise don't copy.
Regrads
Tiya

"Mangesh Yadav" wrote:

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,
"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col +
2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw, 4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah

When and how do you run the macro. Is it a manual action (by pressing a
button somewhere) or are you calling it in another macro. Also on what data
change you want it to run. You could call this macro in the worksheet_change
event.

Mangesh



"Tiya" wrote in message
...
Thanks for reply
I want if there is any change than in data tahn copies new data to the
same
position other wise don't copy.
Regrads
Tiya

"Mangesh Yadav" wrote:

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it
copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,
"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col
+
2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw,
4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah

I just Run prog. It is manual action. I want if same data is there in
worksheet it should not copy again.
E.g.
if i have 10 data for date 1-7-05 than if i entry 11th data it should entry
new data in worksheet and not all data again.
Tiya
"Mangesh Yadav" wrote:

When and how do you run the macro. Is it a manual action (by pressing a
button somewhere) or are you calling it in another macro. Also on what data
change you want it to run. You could call this macro in the worksheet_change
event.

Mangesh



"Tiya" wrote in message
...
Thanks for reply
I want if there is any change than in data tahn copies new data to the
same
position other wise don't copy.
Regrads
Tiya

"Mangesh Yadav" wrote:

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it
copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,
"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col
+
2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw,
4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah

Then you probably need some code like this:

Private Sub Worksheet_Change(ByVal Target As Range)

' this module goes in sheet1 from where data is copied to sheet2
Set mySht = Worksheets("Sheet2") ' this is the sheet where data is
copied to

myRow = mySht.Cells(65536, Target.Column).End(xlUp).Row + 1

mySht.Cells(myRow, Target.Column) = Cells(Target.Row, Target.Column)

End Sub



Sheet 1 is where you enter new data, and sheet2 is where your data gets
copied.

Mangesh




"Tiya" wrote in message
...
I just Run prog. It is manual action. I want if same data is there in
worksheet it should not copy again.
E.g.
if i have 10 data for date 1-7-05 than if i entry 11th data it should
entry
new data in worksheet and not all data again.
Tiya
"Mangesh Yadav" wrote:

When and how do you run the macro. Is it a manual action (by pressing a
button somewhere) or are you calling it in another macro. Also on what
data
change you want it to run. You could call this macro in the
worksheet_change
event.

Mangesh



"Tiya" wrote in message
...
Thanks for reply
I want if there is any change than in data tahn copies new data to the
same
position other wise don't copy.
Regrads
Tiya

"Mangesh Yadav" wrote:

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it
copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run
again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,
"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow,
Col
+
2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw,
4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" &
sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah