VBA to move row to second sheet based on cell value keeping formatting

Excel Noob · Aug 11th 2020

Hi,

I have a working code (for the most part).

I have 2 issues with this code which I can't figure out how to get past.

Purpose of VBA

Workbook contains 2 sheets, the first is named Prospects the second is named Closed

When the command button is clicked, the entire Prospects Sheet should be scanned for the value of "Closed" in column P.

Any row that has "Closed" in column P should be moved into the first available empty row(s) in the Closed Sheet

Any row that is removed from the Prospect Sheet needs to be deleted and shifted up so that there are no empty rows between data and all formatting remains

Issue 1

When the "Closed" row is moved to the Closed Sheet I lose the formatting in that row on the Prospects Sheet. I have Data Validation set in certain columns on the Prospects Sheet and that's gone once the VBA runs.

Issue 2

The code seems to only work for one row at a time. I'd like the code to grab all of the rows that are marked as "Closed" in column P on the Prospects Sheet, following the same criteria as explained above.

Thank you in advance,

Robert

Code

Private Sub CommandButton1_Click()

Dim Check As Range, r As Long, lastrow2 As Long, LastRow As Long

Application.ScreenUpdating = False

LastRow = Worksheets("Prospects").UsedRange.Rows.Count

For r = LastRow To 2 Step -1
    If Worksheets("Prospects").Range("p" & r).Value = "Closed" Then
        Worksheets("Prospects").Rows(r).Cut Destination:=Worksheets("Closed").Range("A" & Rows.Count).End(xlUp)(2)
        
    End If
Next r

Application.ScreenUpdating = True

End Sub

Display More

**royUK** · Aug 11th 2020

That's completely the wrong way to work with data. All data should remain in one sheet then filter for Closed. There's no need to have two sheets

**royUK** · Aug 11th 2020

If you still think it's necessary to move the data then assuming your data is in a table format starting in A1 this should be much faster than your loop.

Code

Option Explicit
Private Sub CommandButton1_Click()


Dim rRng As Range
Dim lCalc As Long
Dim sDelete As String


With Application
lCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
On Error GoTo exit_proc


''///Sheet with the data, change the name
With Worksheets("Prospects")
If Not .AutoFilterMode Then .Range("A1").AutoFilter
.Range("A2").AutoFilter Field:=16, Criteria1:="Closed"


With .AutoFilter.Range '
Set rRng = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)


With Worksheets("Closed")
If Not rRng Is Nothing Then
rRng.Copy.Cells(.Rows.Count, 1).End(xlUp).Offset (1)
rRng.EntireRow.Delete
End If
End With


End With
''///Remove the AutoFilter
.AutoFilterMode = False
End With


exit_proc:
.ScreenUpdating = True
.Calculation = lCalc
End With
End Sub

Display More

Excel Noob · Aug 11th 2020

Hi Roy,

Thank you for the prompt reply. I understand that filtering is the simplest way to do this but I'd really like to be able to keep open prospects on a separate sheet from closed items if possible. I really don't want to have to keep manipulating the sheet to separate those values.

**royUK** · Aug 11th 2020

Try the code that I posted

Excel Noob · Aug 11th 2020

Hi Roy,

Thanks I posted that before I saw your code. I tried it and what it seems to be doing is Auto Filtering the Prospects Sheet, hiding anything that isn't closed. If I have to use Filtering then as you said there's no need for a second sheet or VBA.

There's a couple of things I want to clarify.

1. Rows 1 through 9 are hidden. They contain Data Validation lists.

2. Header values are in A10 and across. All data that needs to be assessed reside in rows 11+ starting in column A.

3. It is a basic Excel sheet, not a table.

VBA to move row to second sheet based on cell value keeping formatting

Participate now!

Share