For Loops and multiple sheets

[328mike]

Hey all,

I need to search for cells in certain columns that are blank and when found cut the entire row and paste it on another page with the empty cell(s) highlighted.

As a test initially I will do this with accounts of status 'closed'.

So the idea is to:
1. Find an account with status closed,c
2. Cut the entire row
3. Paste it on another sheet
4. Highlight it on the 2nd sheet
5. Go back to sheet 1
6. Delete row
7. Continue loop.


This is what I have so far but it does nothing:

[COLOR=SeaGreen]'Begin Closed Accounts Code[/COLOR]
Dim k As Long
For k = 1 To DataRange
    If Cells(1 + k, 14) = "CLOSED" Then
        Rows("k:k").Select
        Selection.Cut
        Sheets("Closed Accounts").Select
        Rows("k:k").Select
        ActiveSheet.Paste
        Sheets("Ready for Submission").Select
        Rows("k:k").Select
        Selection.Delete Shift:=xlUp
    End If
    Next k

 

[VoG]

Try this

Sub MoveTest()
Dim i As Long, LR As Long
With Sheets("Ready for Submission")
    LR = .Range("N" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        If UCase(.Range("N" & i), Value) = "CLOSED" Then .Rows(i).Cut Destination:=Sheets("Closed Accounts").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next i
    On Error Resume Next
    .Range("N1:N" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
End With
End Sub

 

[328mike]

edit: nvm I just had to change the active row from N to Z. Thanks so much!!

 

[VoG]

Oops!

Sub MoveTest()
Dim i As Long, LR As Long
With Sheets("Ready for Submission")
    LR = .Range("N" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        If UCase(.Range("N" & i).Value) = "CLOSED" Then .Rows(i).Cut Destination:=Sheets("Closed Accounts").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next i
    On Error Resume Next
    .Range("N1:N" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
End With
End Sub

 

[328mike]

Another question for you VOG!! (or any knowledgeable board members!!!)

I am trying to now highlight a cell where I am finding missing information. At the moment when I paste the cell on the other sheet I can't seem to highlight the cell that triggered the paste, instead I am getting the entire column painted and none of the bad cells. Here is the code:

'Begin account filtering code
Dim k As Long, LR As Long
With Sheets("Ready for Submission")
    LR = .Range("Z" & Rows.Count).End(xlUp).Row
    For k = 1 To LR
        If Range("Z" & k).Value = "CLOSED" Then .Rows(k).Cut Destination:=Sheets("Closed Accounts").Range("A" & Rows.Count).End(xlUp).Offset(1)
        If Range("Q" & k).Value = "" Then .Rows(k).Cut Destination:=Sheets("Missing Information").Range("A" & Rows.Count).End(xlUp).Offset(1)
        If Sheets("Missing Information").Range("A" & k).Value <> "" Then Sheets("Missing Information").Range("N" & k).Interior.ColorIndex = 40
        Next k
    On Error Resume Next
    .Range("Z1:Z" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
End With

 

[VoG]

Should it be?

Dim k As Long, LR As Long
With Sheets("Ready for Submission")
    LR = .Range("Z" & Rows.Count).End(xlUp).Row
    For k = 1 To LR
        If .Range("Z" & k).Value = "CLOSED" Then .Rows(k).Cut Destination:=Sheets("Closed Accounts").Range("A" & Rows.Count).End(xlUp).Offset(1)
        If .Range("Q" & k).Value = "" Then .Rows(k).Cut Destination:=Sheets("Missing Information").Range("A" & Rows.Count).End(xlUp).Offset(1)
        If Sheets("Missing Information").Range("A" & k).Value = "" Then Sheets("Missing Information").Range("N" & k).Interior.ColorIndex = 40
        Next k
    On Error Resume Next
    .Range("Z1:Z" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
End With