re-work this macro (create new row)

[M3L333]

Instead of "find next row to paste to on Discharges", how could I have this macro create a new row between row 1 & 2 to paste to information there. This way, my most current information would always be on top.

Private Sub CommandButton1_Click()

Dim lr As Long
Dim r As Long
Dim nr As Long

Application.ScreenUpdating = False

' Find last row in column P with data on Bed Registry
lr = Sheets("Bed Registry").Cells(Rows.Count, "P").End(xlUp).Row

' Loop through all rows on Bed Registry and check column P for closed
For r = 2 To lr
If Sheets("Bed Registry").Cells(r, "P") = "CLOSED" Then
' Find next row to paste to on Discharges
nr = Sheets("Discharges").Cells(Rows.Count, "P").End(xlUp).Row + 1
' Copy columns B-P to Discharges
Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r, "P")).Copy Sheets("Discharges").Cells(nr, "B")
' Clear columns B-P on Bed Registry
Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r, "P")).ClearContents
End If
Next r

Application.ScreenUpdating = True

End Sub

 

[Joe4]

Try something like this:

Private Sub CommandButton1_Click()

    Dim lr As Long
    Dim r As Long

    Application.ScreenUpdating = False

'   Find last row in column P with data on Bed Registry
    lr = Sheets("Bed Registry").Cells(Rows.Count, "P").End(xlUp).Row

'   Loop through all rows on Bed Registry and check column P for closed
    For r = 2 To lr
        If Sheets("Bed Registry").Cells(r, "P") = "CLOSED" Then
'           Insert row at row 2
            Sheets("Discharges").Activate
            Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'           Copy columns B-P to Discharges on row 2
            Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r, "P")).Copy Sheets("Discharges").Cells(2, "B")
'           Clear columns B-P on Bed Registry
            Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r, "P")).ClearContents
        End If
    Next r
    
End Sub

 

[Logit]

.

Range("A2").EntireRow.Insert

The above inserts a row at Row 2 and shift all others down.

 

[M3L333]

This is not working right unfortunately. It is inserting the row on the wrong sheet.

 

[Joe4]

Who are you responding to, me or Logit?
Did you try my response?

 

[M3L333]

Sorry. I was trying to respond to you. I think the part Insert row at row 2 needs to be defined to the "Discharges" worksheet as it is creating the row on the wrong sheet. I haven't been able to get it to work properly.

 

[Joe4]

Did you include the line right above the row insert step?

            [COLOR=#ff0000]Sheets("Discharges").Activate[/COLOR]
            Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

If you include that line, I don't see how it can not insert the row on the "Discharges" page, as it is selecting/activating that sheet before inserting the row.
So the "Discharges" sheet should be the active sheet when it runs that line.
Try stepping through your code line-by-line while watching what it is doing on your workbook at the same time.

 

[M3L333]

I have reworked the macro (below) to insert a row at the top, instead of the bottom. However the information in row 2 is just replacing old information, rather than moving down. How could I get the information to move down each time information is transferred? Thanks Private Sub CommandButton1_Click()<o></o>
<o> </o>
Dim lr As Long<o></o>
Dim r As Long<o></o>
Dim nr As Long<o></o>
<o> </o>
Application.ScreenUpdating = False<o></o>
<o> </o>
'Find lr column P with data on Bed Registry<o></o>
lr = Sheets("Bed Registry").Cells(Rows.Count,"P").End(xlUp).Row<o></o>
<o> </o>
'Find lcol - LastColumn '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''<o></o>
'lcol = Sheets("Bed Registry").ActiveSheet.Cells(1,Application.Columns.Count).End(xlToRight).Column<o></o>
<o> </o>
'Loop through all rows on Bed Registry and check column Pfor closed<o></o>
For r = 2 To lr<o></o>
IfSheets("Bed Registry").Cells(r, "P") = "CLOSED"Then<o></o>
Sheets("Discharges").Range("A2").Select<o></o>
ActiveCell.EntireRow.Insert Shift:=xlDown<o></o>
'CopyOrigin:=xlFormatFromLeftOrAbove<o></o>
'Copycolumns B-P to "Discharges" on row 2<o></o>
'Sheets("Bed Registry").Range(Cells(r, "B"),Cells(r, "P")).Copy Sheets("Discharges").Range (Cells(2,"B"), (Cells r, "P"))<o></o>
'Clearcolumns B-P on Bed Registry<o></o>
Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r,"P")).ClearContents<o></o>
End If<o></o>
Next r<o></o>
<o> </o>
End Sub<o></o>

 

[Joe4]

I think you missed changing the last "r" to "2" in your copy command.
See if this works:

Private Sub CommandButton1_Click()

Dim lr As Long
Dim r As Long
Dim nr As Long

Application.ScreenUpdating = False

'Find lr column P with data on Bed Registry
lr = Sheets("Bed Registry").Cells(Rows.Count, "P").End(xlUp).Row

'Find lcol - LastColumn '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'lcol = Sheets("Bed Registry").ActiveSheet.Cells(1,Application.Columns.Count).End(xlToRight).Column


'Loop through all rows on Bed Registry and check column Pfor closed
For r = 2 To lr
    If Sheets("Bed Registry").Cells(r, "P") = "CLOSED" Then
        Sheets("Discharges").Activate
        Range("A2").EntireRow.Insert Shift:=xlDown
'CopyOrigin:=xlFormatFromLeftOrAbove
'       Copycolumns B-P to "Discharges" on row 2
        Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r, "P")).Copy Sheets("Discharges").Range(Cells(2, "B"), Cells([COLOR=#ff0000][B]2[/B][/COLOR], "P"))
'       Clearcolumns B-P on Bed Registry
        Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r, "P")).ClearContents
    End If
Next r


End Sub

 

[M3L333]

Thanks, I tried that but it did not work. I actually pasted the wrong macro though. This is the one I am currently working with that is not moving the row down. Private Sub CommandButton1_Click()<o></o>
<o> </o>
Dim lr As Long<o></o>
Dim r As Long<o></o>
<o> </o>
<o> </o>
Application.ScreenUpdating = False<o></o>
<o> </o>
<o> </o>
'Find lr column P with data on Bed Registry<o></o>
lr = Sheets("Bed Registry").Cells(Rows.Count,"P").End(xlUp).Row<o></o>
<o> </o>
<o> </o>
'Loop through all rows on Bed Registry and check column Pfor closed<o></o>
For r = 2 To lr<o></o>
If Sheets("Bed Registry").Cells(r, "P")= "CLOSED" Then<o></o>
'Sheets("Discharges").Activate<o></o>
'Insert r at r2<o></o>
'Rows("2:2").Insert Shift:=xlDown,<o></o>
'CopyOrigin:=xlFormatFromLeftOrAbove<o></o>
'Copy columns B-P to Discharges on row 2<o></o>
Sheets("Bed Registry").Range(Cells(r,"B"), Cells(r, "P")).CopySheets("Discharges").Cells(2, "B")<o></o>
'Clear columns B-P on Bed Registry<o></o>
Sheets("Bed Registry").Range(Cells(r,"B"), Cells(r, "P")).ClearContents<o></o>
End If<o></o>
Next r<o></o>
<o> </o>
End Sub<o></o>