View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.misc
Dr Hackenbush Dr Hackenbush is offline
external usenet poster
 
Posts: 6
Default Macro required please

Per
Will do , thanks for the advice

once again thanks for your time and help
Dr H

"Per Jessen" wrote in message
...
Hi Dr H

Thanks for your reply.

Good you solved my typo error. As only new entries are marked with 'y',
you have to use my second Set DestCell=... statement which is currently
commented out to write new data to first empty line. The statement 'Set
DestCell = ShB.Range("B2") ' can be deleted or commented out.

Best regards,
Per

"Dr Hackenbush" skrev i meddelelsen
...
Hi Per

It works perfectly, I had to make one small change which I think was just
a typing error, Set DestCell = ShB.Range("B2") changed B2 to A2,

On Sheet1 "y" will only be new entries as after processing they change
to "done"

Thanks very much for your time Its really appreciated

all the best
Dr H

"Per Jessen" wrote in message
...
Hi

Not sure how to determine which entries are new, so the macro just copy
all entries marked with "y" each time the macro run.

Try this one:

Sub AAA()
Dim ShA As Worksheet
Dim ShB As Worksheet
Dim DestCell As Range
Dim TargetRng As Range

Application.ScreenUpdating = False
Set ShA = Worksheets("Sheet1")
Set ShB = Worksheets("Sheet2")
Set DestCell = ShB.Range("B2")
'Set DestCell = ShB.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Set TargetRng = ShA.Range("F2", ShA.Range("F" & Rows.Count).End(xlUp))

For Each cell In TargetRng
If cell.Value = "y" Then
ShA.Range("A" & cell.Row).Resize(1, 2).Copy DestCell
If cell.Offset(0, 2) = "ch" Then
DestCell.Offset(0, 2) = cell.Offset(0, 1)
Else
DestCell.Offset(0, 3) = cell.Offset(0, 1)
End If
Set DestCell = DestCell.Offset(1, 0)
End If
Next
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Dr Hackenbush" skrev i meddelelsen
...
This is a repost as I dont think I made much sense previously. !

Here is a graphic of what I would like to get

http://tinypic.com/r/21jx9gm/6

Doesnt need to delete anything just copy and sort from Sheet1 to
Sheet2, and each time its run add the new records it finds above or
below whats already there.

Thanks for looking and hopefully helping me out !