Code to move rows with a blank cell/s to top of range

[L. Howard]

With a range that the number of rows will vary and the number of columns will vary I want to do this:

For each row in range if row cell/s = blank then move row to top of range, next row.

Where "cell/s" would be a cell or a few cells but not a completely blank row.

End results would look like this:

First row with blank cell would be first row of new range, 2nd row with a blank would the next until all rows with a blank are at the top of the range and all rows without a blank are below in the order they originally were.

Title says I want code but if Excel sort functions can do this that seems okay with me.

Thanks.
Howard

 

[JoeMo]

With a range that the number of rows will vary and the number of columns will vary I want to do this:

For each row in range if row cell/s = blank then move row to top of range, next row.

Where "cell/s" would be a cell or a few cells but not a completely blank row.

End results would look like this:

First row with blank cell would be first row of new range, 2nd row with a blank would the next until all rows with a blank are at the top of the range and all rows without a blank are below in the order they originally were.

Title says I want code but if Excel sort functions can do this that seems okay with me.

Thanks.
Howard

Adjust the range R address to match your range:

Sub BlanksToTop()
Dim R As Range, newR As Range, rw As Range, n As Long
Set R = Range("A1:G18") 'Adjust range to suit
Application.ScreenUpdating = False
R.EntireColumn.Insert
Set newR = R.Offset(0, -R.Columns.Count)
For Each rw In R.Rows
    If WorksheetFunction.CountA(rw) < rw.Cells.Count Then
        n = n + 1
        newR.Rows(n).Value = rw.Value
    End If
Next rw
For Each rw In R.Rows
    If WorksheetFunction.CountA(rw) = rw.Cells.Count Then
        n = n + 1
        newR.Rows(n).Value = rw.Value
    End If
Next rw
R.Value = newR.Value
newR.EntireColumn.Delete
End Sub

 

[hiker95]

L. Howard,

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H
1	Title A	Title B	Title C	Title D	Title E	Title F	Title G	Title H
2	2		2		2			2
3		3		3		3	3
4
5	5	5	5	5	5	5	5	5
6
7	7
8		8
9
10	10						10
11					11
12
13				13
14
Sheet1

After the macro:

Excel 2007
	A	B	C	D	E	F	G	H
1	Title A	Title B	Title C	Title D	Title E	Title F	Title G	Title H
2
3
4
5
6	2		2		2			2
7		3		3		3	3
8	5	5	5	5	5	5	5	5
9	7
10		8
11	10						10
12					11
13				13
14
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub MoveBlankRowsUP()
' hiker95, 04/13/2013
' http://www.mrexcel.com/forum/excel-questions/696918-code-move-rows-blank-cell-s-top-range.html
Dim r As Long, lr As Long, lc As Long, n As Long, nn As Long
lr = Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
lc = Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
nn = 0
For r = lr To 2 Step -1
  n = Application.CountA(Range(Cells(r, 1), Cells(r, lc)))
  If n = 0 Then
    nn = nn + 1
    Rows(r).Delete
  End If
Next r
If nn > 0 Then
  Rows(2).Resize(nn).Insert
End If
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the MoveBlankRowsUP macro.

 

[L. Howard]

Hi JoeMoe and Hiker95,

Thanks for your responses.

My bad where I may have done a "Ready, Fire, Aim"

My range is A2:AJ200, w/ Headers in A1:AJ1. The range may change but I don't think the code will needs to try to adjust to any varying range size, I believe if I name the range and apply the code to the named range I will be okay.

My big bad is we can key on column S alone, if it is blank then move "Range("Sx").Offset(0, -18).Resize(1, 36)" to the top, next blank S under the previous.

Thanks.
Howard

 

[JoeMo]

Hi JoeMoe and Hiker95,

Thanks for your responses.

My bad where I may have done a "Ready, Fire, Aim"

My range is A2:AJ200, w/ Headers in A1:AJ1. The range may change but I don't think the code will needs to try to adjust to any varying range size, I believe if I name the range and apply the code to the named range I will be okay.

My big bad is we can key on column S alone, if it is blank then move "Range("Sx").Offset(0, -18).Resize(1, 36)" to the top, next blank S under the previous.

Thanks.
Howard

I revised my code so you can select the range you want to reorder when prompted. Do not include the header row.

Sub BlanksToTop()
Dim R As Range, newR As Range, rw As Range, n As Long

On Error Resume Next
Set R = Application.InputBox("Use your mouse to select the range you want to reorder. Do not include any header row.", Type:=8)
If R Is Nothing Then Exit Sub
On Error GoTo 0
Application.ScreenUpdating = False
R.EntireColumn.Insert
Set newR = R.Offset(0, -R.Columns.Count)
For Each rw In R.Rows
    If WorksheetFunction.CountA(rw) < rw.Cells.Count Then
        n = n + 1
        newR.Rows(n).Value = rw.Value
    End If
Next rw
For Each rw In R.Rows
    If WorksheetFunction.CountA(rw) = rw.Cells.Count Then
        n = n + 1
        newR.Rows(n).Value = rw.Value
    End If
Next rw
R.Value = newR.Value
newR.EntireColumn.Delete
End Sub

 

[L. Howard]

I tried the revised code where at the InputBox prompt I selected A2:AJ200, click OK. Long pause w/ hour glass, 10 to 15 seconds and page reverts to sheet module, no error noted. Sheet remains unchanged.

If I select column S for Input Box prompt works fine to move all column S blanks to top, but not the row data from A to AJ with it.

Any ideas? Am I using the code correctly?

Howard

 

[hiker95]

L. Howard,

Sample raw data:

Excel 2007
	A	R	S	T	AJ
1	A	R	S	T	AJ
2	2	2	2	2	2
3	3	3	3	3	3
4	4	4		4	4
5	5	5	5	5	5
6	6	6		6	6
7	7	7	7	7	7
8	8	8	8	8	8
9	9	9		9	9
10	10	10	10	10	10
11	11	11	11	11	11
12	12	12		12	12
13	13	13	13	13	13
14	14	14		14	14
15	15	15		15	15
16	16	16	16	16	16
17	17	17	17	17	17
18	18	18	18	18	18
19	19	19		19	19
20	20	20	20	20	20
21	21	21		21	21
22	22	22	22	22	22
23	23	23	23	23	23
24	24	24	24	24	24
25	25	25		25	25
26	26	26	26	26	26
27	27	27	27	27	27
28	28	28		28	28
29	29	29	29	29	29
30	30	30		30	30
31
Sheet1

After the very fast macro using arrays in memory:

Excel 2007
	A	R	S	T	AJ
1	A	R	S	T	AJ
2	4	4		4	4
3	6	6		6	6
4	9	9		9	9
5	12	12		12	12
6	14	14		14	14
7	15	15		15	15
8	19	19		19	19
9	21	21		21	21
10	25	25		25	25
11	28	28		28	28
12	30	30		30	30
13	2	2	2	2	2
14	3	3	3	3	3
15	5	5	5	5	5
16	7	7	7	7	7
17	8	8	8	8	8
18	10	10	10	10	10
19	11	11	11	11	11
20	13	13	13	13	13
21	16	16	16	16	16
22	17	17	17	17	17
23	18	18	18	18	18
24	20	20	20	20	20
25	22	22	22	22	22
26	23	23	23	23	23
27	24	24	24	24	24
28	26	26	26	26	26
29	27	27	27	27	27
30	29	29	29	29	29
31
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub MoveBlank_S_UP()
' hiker95, 04/13/2013
' http://www.mrexcel.com/forum/excel-questions/696918-code-move-rows-blank-cell-s-top-range.html
Dim a As Variant, b As Variant, s As Variant
Dim lr As Long, lc As Long, n As Long, nr As Long
Dim i As Long, ii As Long, iii As Long, c As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
n = Application.CountA(Range("S2:S" & lr))
a = Range("A2:AJ" & lr)
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
ReDim s(1 To lr - n - 1, 1 To UBound(a, 2))
For i = 1 To UBound(a, 1)
  If a(i, 19) = "" Then
    ii = ii + 1
    For c = 1 To UBound(a, 2)
      s(ii, c) = a(i, c)
    Next c
  Else
    iii = iii + 1
    For c = 1 To UBound(a, 2)
      b(iii, c) = a(i, c)
    Next c
  End If
Next i
Range("A2:AJ" & lr).ClearContents
Range("A2").Resize(UBound(s, 1), UBound(s, 2)) = s
nr = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Range("A" & nr).Resize(UBound(b, 1), UBound(b, 2)) = b
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the MoveBlank_S_UP macro.

 

[L. Howard]

Hi Hiker95,

Nailed it!!!!

Very nice and bullet fast.
I will probably never learn to how dump data to an array to be processed and dump it back to the sheet but it sure works well.

I run this little snippet, which contributes to some blanks in Col. S and along comes your gold nugget and cleans it all up.

Option Explicit
Sub Col_S_Failed_Del()
Dim c As Range
For Each c In Range("S:S")
  If c.Value = "Failed" Then
    c.Offset(0, -1).Resize(1, 2).ClearContents
  End If
Next
MoveBlank_S_UP
End Sub

Thanks very much, I appreciate it.

Regards,
Howard

 

[hiker95]

L. Howard,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.