pls reply Parick Molloy

[Guest]

Hi Parick Molloy i am Tiya Shah you have given reply to my problem but still
i have problem.
My problem is it's runing and crating new worksheet with date name but if i
add new data in same date and than i run the prog. I should copy only new
data but this prog. copy old data also in new rows i just want to add only
new data if i run prg. again.

I am pasting code
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



pls reply me
or if possible for you to than i mail you my file so pls give your e-mail ID.
Thanks
Regards
Tiya

 

[Dave Peterson]

I'm not Patrick, but I think you have a couple of choices.

Choice #1: Recreate each worksheet each time you run it--toss the old data on
those other sheets and then just repopulate everything like it was never copied.

Choice #2: Add a column to your Data worksheet that indicates if the data
should be copied. Put an X in column Z. If you find an X in that column Z of
that row, wipe out the X (so it won't get copied again) and then copy the row.

 

[Guest]

Thanks Dave Peterson for reply
I don't have more knowgle of Prog. can you help me with Choice #2 given by
you.

Thanks

tiya shah

 

[Dave Peterson]

I used column Z (change it to the one you want) and I changed it to just look
for anything--so you can use an X, a dot, YES, any non-empty cell will do it.

And the only portion that needs to be modified is that Do/Loop:

Do Until ws.Cells(rw, 1).Value = ""
If IsEmpty(ws.Cells(rw, "Z")) Then
'do nothing
Else
'do the work, but first, clean up column Z
ws.Cells(rw, "Z").ClearContents
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
End If
Loop


If you don't use column Z, remember to change it in both spots.

 

[Guest]

Thanks Dave Peterson for reply
I use your code i modiifed only Do/Loop portion but when i run the code it
not working and excel is not working it's comes not responding prog.

I think if i go with choose #1 given by you i.e.
Recreate each worksheet each time you run it--toss the old data on those
other sheets and then just repopulate everything like it was never copied.

I am given you more trouble but it would be a great help for me if you give
code for choose #1.

Thanks
Tiya Shah

 

[Dave Peterson]

Bad testing (none!) by me:

Do Until ws.Cells(rw, 1).Value = ""
If IsEmpty(ws.Cells(rw, "Z")) Then
'do nothing
Else
'do the work, but first, clean up column Z
ws.Cells(rw, "Z").ClearContents
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
End If
rw = rw + 1 'moved outside the "else" portion
Loop

=========

If you still want to try the second suggestion...

You may want to look at how Debra Dalgleish approaches a similar situation:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list; macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

and how Ron de Bruin did it with his easyfilter addin:
http://www.rondebruin.nl/easyfilter.htm

Thanks Dave Peterson for reply
I use your code i modiifed only Do/Loop portion but when i run the code it
not working and excel is not working it's comes not responding prog.

I think if i go with choose #1 given by you i.e.
Recreate each worksheet each time you run it--toss the old data on those
other sheets and then just repopulate everything like it was never copied.

I am given you more trouble but it would be a great help for me if you give
code for choose #1.

Thanks
Tiya Shah