VBA if/and statement move rows

[HappyLadyToo]

Hello All,

Below is a formula I found on the website and I've been trying to modify it and make it work for what I need but to no avail.

Here's what I'm trying to do: In column B is a list of last names, however, some of the cells are empty. For those cells that are empty but the row still has other info, I want to copy the row from spreadsheet 'npc main' to spreadsheet 'review'. Both are in the same workbook. Once the row has been copied, it should be deleted from 'npc main'. When I run the macro below, it runs through column B but nothing is copied and the macro won't end when it reaches an empty row. I've been working on it for two days and now I'm asking for help. Thank you for your time.


Sub Workbook_Open()

Dim temp1 As String
Dim temp2 As String
Dim temp3 As String


Sheets("npc main").Select
Range("B1").Select
While ActiveCell.Value <> "*"

temp1 = ""

temp1 = Left(ActiveCell.Value, 2)


If temp1 = "" And Row <> "" Then

Rows(ActiveCell.Row).Copy
Sheets("review").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Sheets("npc main").Select
Application.CutCopyMode = False

End If


ActiveCell.Offset(1, 0).Select


Wend
End Sub

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG04Feb39
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]With[/COLOR] Sheets("npc main")
[COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 1) = vbNullString [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] nRng.EntireRow
    .Copy Sheets("review").Range("A2")
    .Delete
[COLOR="Navy"]End[/COLOR] With
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[HappyLadyToo]

You are fantastic!! Thanks!

 

[HappyLadyToo]

One more thing, if I want to include column E and process at the same time, how would that be written?

 

[MickG]

If you mean having blanks in column "B" and column "E", as criteria .
Try this:-

[COLOR="Navy"]Sub[/COLOR] MG04Feb40
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]With[/COLOR] Sheets("npc main")
[COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 1) = vbNullString Or Dn.Offset(, 4) = vbNullString [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] nRng.EntireRow
    .Copy Sheets("review").Range("A2")
    .Delete
[COLOR="Navy"]End[/COLOR] With
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[HappyLadyToo]

Thanks again! It didn't work but I realized after the fact that's not quite what I want to do anyway. Your first macro works beautifully and I want to color code the blank cells in column E which I think I can do. I'm going to try anyway.

Appreciate your help...