ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Macro required please (https://www.excelbanter.com/excel-discussion-misc-queries/255756-macro-required-please.html)

Dr Hackenbush

Macro required please
 
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 !



Per Jessen

Macro required please
 
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 !


Dr Hackenbush

Macro required please
 
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 !




Per Jessen

Macro required please
 
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 !




Dr Hackenbush

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 !







All times are GMT +1. The time now is 10:30 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com