Need help deleting certain rows

[wiegs187]

Hi,

I have a spreadsheet with data in columns A and B. In both columns the data is sporatic, meaning most cells are empty, some have data, and the ones that do have data are pretty random.

I need code to look at a rows from a cell that has a value in column A to 1 row above the next cell in column A that has a value. Then within that range, if all cells in column B are empty then all rows within the range should be deleted, but if there is anything in any of the cells in column B then the whole range should stay. Then move on to the next range and repeat.

Let me know if I'm not making any sense. It seems like a straight forward macro, but I can't figure out what to do.

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG04Mar46
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] rRay
[COLOR="Navy"]Dim[/COLOR] nTxt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Dn <> "" And Dn.Offset(1) = "" And Not Dn.Address = Rng(Rng.Count).Address [COLOR="Navy"]Then[/COLOR]
            txt = txt & Dn.Address & ":"
        [COLOR="Navy"]ElseIf[/COLOR] Dn = "" And Dn.Offset(1) <> "" [COLOR="Navy"]Then[/COLOR]
            txt = txt & Dn.Address & ","
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
        txt = Left(txt, Len(txt) - 1)
            rRay = Split(txt, ",")
                 ReDim nRay(1 To UBound(rRay) + 1)
    [COLOR="Navy"]For[/COLOR] n = UBound(rRay) To 0 [COLOR="Navy"]Step[/COLOR] -1
        c = c + 1
        nTxt = nTxt & rRay(n) & ","
    [COLOR="Navy"]Next[/COLOR] n
        nTxt = Left(nTxt, Len(nTxt) - 1)
 
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Range(nTxt).Areas
        [COLOR="Navy"]If[/COLOR] Application.CountA(R.Offset(, 1)) = 0 [COLOR="Navy"]Then[/COLOR]
            R.EntireRow.Delete
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick