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
Tiya wrote:
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" wrote:
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.
Tiya wrote:
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" wrote:
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.
Tiya wrote:
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
--
Dave Peterson
--
Dave Peterson