Macro question: how to copy the last row from a range with criteria by means of macro V2

P

Paulus1983

New Member
Joined
Jan 7, 2008
Messages
12
Hello,

Not too long ago I posted the following question:
http://www.mrexcel.com/forum/showthread.php?p=2647298#post2647298

what will a macro look like that allows me to copy the final row from a specific range (eg. B5:M27) to the next row. So I'm looking for a macro that searches for the final row in a pre-set range and copies this row to the next, when the macro is activated.

In the example above the final row can be ranging from 5 to 27.

And received the following Macro as an answer:

Sub CopyRow()
Last = Cells(Rows.Count, "B").End(xlUp).Row
With Cells(Last, "B")
.Offset(1, 0).Value = Cells(Last, "B").Value
.Offset(1, 1).Value = .Offset(, 1).Value
.Offset(1, 2).Value = .Offset(, 2).Value
.Offset(1, 3).Value = .Offset(, 3).Value
.Offset(1, 4).Value = .Offset(, 4).Value
.Offset(1, 5).Value = .Offset(, 5).Value
.Offset(1, 6).Value = .Offset(, 6).Value
.Offset(1, 7).Value = .Offset(, 7).Value
.Offset(1, 8).Value = .Offset(, 8).Value
.Offset(1, 9).Value = .Offset(, 9).Value
.Offset(1, 10).Value = .Offset(, 10).Value
.Offset(1, 11).Value = .Offset(, 11).Value
.Offset(1, 12).Value = .Offset(, 12).Value
End With
End Sub

This worked great but I would like to change the criteria. Instead of determining the row to copy based on the final row that contains data in column B, I would like to determine the row to copy based on the cell selected in column A.
eg. if the relevant range is B5:M27 and A8 is selected, the macro should copy B8:M8 and past it to the next.

Thank you very much for all help!
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
I'm not sure that this is exactly what you're looking for, but the following macro first checks to make sure that the active cell lies within the target range A5:A27. If so, it copies Column B through Column M for the row corresponding to the active cell and pastes it to the next available row starting at Column B. If the active cell does not lie within the target range, a message pops up to indicate that such is the case.

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] CopyRow()

    [color=darkblue]Dim[/color] r [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] NextRow [color=darkblue]As[/color] [color=darkblue]Long[/color]

    [color=darkblue]If[/color] [color=darkblue]Not[/color] Intersect(Range("A5:A27"), ActiveCell) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]

        r = ActiveCell.Row
        
        NextRow = Cells(Rows.Count, "B").End(xlUp).Row + 1
    
        Range(Cells(r, "B"), Cells(r, "M")).Copy Destination:=Cells(NextRow, "B")
        
    [color=darkblue]Else[/color]
    
        MsgBox "Active cell is not located within A5:A27...", vbExclamation
        
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]
 
Upvote 0
Hi Domenic,

Thank you very much for your help. The code works well. I'm starting to get a little familiar with VBE and combined your code and another code I received:

Sub CopyRow()
Dim Last as Long
Last = ActiveCell.Row
Range(Cells(Last + 1, "B"), (Cells(Last + 1, "M"))).Value = Range(Cells(Last, "B"), (Cells(Last, "M"))).Value
End Sub


And came up with the following:

Option Explicit

Sub CopyRow()

Dim last As Long

If Not Intersect(Range("A5:A27"), ActiveCell) Is Nothing Then

Last = ActiveCell.Row

Range(Cells(Last + 1, "B"), (Cells(Last + 1, "M"))).Value = Range(Cells(Last, "B"), (Cells(Last, "M"))).Value

Else

MsgBox "Active cell is not located within A5:A27...", vbExclamation

End If

End Sub

This code follows the criteria that the active cell should be placed in column A but doesn't make a count in column B to find out what the final cell is.

Thanks very much!
 
Upvote 0
Hi Domenic,

Perhaps you can help me also with the following question:

Based on the previous answer I managed to write a new code that deletes a row instead of copying it:

Sub deleterow()


Dim last As Long

If Not Intersect(Range("B5:B2050"), ActiveCell) Is Nothing Then

last = ActiveCell.Row

Range(Cells(last, "D"), (Cells(last, "W"))).Select

Selection.ClearContents

Else

MsgBox "Active cell is not located within orange vertical column...", vbExclamation

End If

End Sub


This code deletes the range D:W on the activeCell.Row which is selected by selecting any cell on column B ("B5:B2050").


If I want to add an additional ranges to be deleted on the active row (D:W,Z:AA,AN:AO,AR:AS), how can I then easily write this range within the code above without duplicating the code?

So how to include the additional ranges into this part:

Range(Cells(last, "D"), (Cells(last, "W"))).Select

Would appreciate your help!

Thanks in advance
 
Upvote 0
Paulus1983 said:
Hi Domenic,

Perhaps you can help me also with the following question:

Based on the previous answer I managed to write a new code that deletes a row instead of copying it:

Sub deleterow()


Dim last As Long

If Not Intersect(Range("B5:B2050"), ActiveCell) Is Nothing Then

last = ActiveCell.Row

Range(Cells(last, "D"), (Cells(last, "W"))).Select

Selection.ClearContents

Else

MsgBox "Active cell is not located within orange vertical column...", vbExclamation

End If

End Sub


This code deletes the range D:W on the activeCell.Row which is selected by selecting any cell on column B ("B5:B2050").


If I want to add an additional ranges to be deleted on the active row (D:W,Z:AA,AN:AO,AR:AS), how can I then easily write this range within the code above without duplicating the code?

So how to include the additional ranges into this part:

Range(Cells(last, "D"), (Cells(last, "W"))).Select

Would appreciate your help!

Thanks in advance
Click to expand...

Try...

Code: 
[font=Verdana]    Range("D" & LastRow & ":W" & LastRow & ",Z" & LastRow & ":AA" & LastRow & ",AN" & LastRow & ":AO" & LastRow & ",AR" & LastRow & ":AS" & LastRow).ClearContents[/font]
 
Upvote 0
Hi Domenic,

Thanks again. I inserted it and unfortunately received an error on this code.

This is the complete code. Could you maybe check if there's something I did wrong?


Sub deleterow()


Dim last As Long

If Not Intersect(Range("B5:B2050"), ActiveCell) Is Nothing Then

last = ActiveCell.Row

Range("D" & LastRow & ":W" & LastRow & ",Z" & LastRow & ":AA" & LastRow & ",AN" & LastRow & ":AO" & LastRow & ",AR" & LastRow & ":AS" & LastRow).ClearContents

Else

MsgBox "Active cell is not located within orange vertical column...", vbExclamation

End If

End Sub
 
Upvote 0
Try...

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] DeleteRow()

    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Intersect(Range("B5:B2050"), ActiveCell) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
    
        LastRow = ActiveCell.Row
    
        Range("D" & LastRow & ":W" & LastRow & ",Z" & LastRow & ":AA" & LastRow & ",AN" & LastRow & ":AO" & LastRow & ",AR" & LastRow & ":AS" & LastRow).ClearContents
    
    [color=darkblue]Else[/color]
    
        MsgBox "Active cell is not located within orange vertical column...", vbExclamation
    
    [color=darkblue]End[/color] [color=darkblue]If[/color]

End [color=darkblue]Sub[/color]
[/font]
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
Web search using Excel VBA error and script corrections
2
Replies
10
Views
231
Edgar_
Edgar_
C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
336
NdNoviceHlp
NdNoviceHlp
J
  • Question Question
Copying Rows Based on Column Value
Replies
1
Views
157
jolivanes
jolivanes
V
  • Question Question
VBA excel worksheet2 out of range even though the cell is within the range and additional value created
Replies
4
Views
257
MARK858
MARK858
G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
376
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,591
Messages
6,179,768
Members
452,940
Latest member
rootytrip

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top