move text to top problem

[123excel]

Hi, I am trying to move text up in a range when there is empty rows above or in between. I thought I had got it to work but I just found out a big problem, it clears and copies the wrong rows.

Does anyone of you experts think you could help me out with this problem?


Here is an example of the problem:

If I got:
1
empty
3
4
5

This should be:
1
3
4
5

But now the outcome is:
1
3
3
4
(as you can see, 3 is copied and 5 is deleted. The text should just move up).



The code I am using is this:

Public Sub RowRange()


  Dim oRange As Range
  
  Set oRange = Range("A36:G164")
  MoveTextUp oRange
  
End Sub


Public Sub MoveTextUp(ByRef oRange As Range)
  Dim i As Integer
  Dim j As Integer
  
  For i = 1 To oRange.Rows.Count
    If oRange.Value2(i, 1) = "" Then
      If Intersect(oRange, oRange(i, 1).End(xlDown)) Is Nothing Then Exit Sub
        For j = 1 To 6 Step 1
          oRange(i, j).Value = oRange(i, j).End(xlDown).Value
          oRange(i, j).End(xlDown).Value = ""
        Next
    End If
  Next

End Sub

 

[DanteAmor]

Try this

Sub Macro9()
    On Error Resume Next
    Range("A36:G164").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End Sub

 

[123excel]

Thanks, but the problem is that I cant use delete, i need move the empty rows in range A36:G164 down and the ones with text to the top. Any idea here?

 

[DanteAmor]

Thanks, but the problem is that I cant use delete, i need move the empty rows in range A36:G164 down and the ones with text to the top. Any idea here?

rows or cells?
In which column of the range "A36:G164" do you want to verify?

 

[123excel]

Cells. I want to verify if any of the cells in A:G is having any text. Lets say A36:G36 is empty, and A37:G37 also is empty except B37 that have som text, then all the cells in A37:G37 should move over A36:G36. Did this clarify it?

 

[DanteAmor]

Cells. I want to verify if any of the cells in A:G is having any text. Lets say A36:G36 is empty, and A37:G37 also is empty except B37 that have som text, then all the cells in A37:G37 should move over A36:G36. Did this clarify it?

move or pass the value from A37 to A36 and then A37 = empty?

If the above is correct then try this:

Sub RowRange()
    Dim r As Range, ini As Long, i As Long
    Dim rs As Range, k As Long, wcount As Long
    
    Application.ScreenUpdating = False
    Set r = Range("A36:G164")
    For Each rs In r.Rows
        wcount = WorksheetFunction.CountA(rs)
        If wcount = 0 Then
            k = 1
            Do While k <= r.Rows.Count
                wcount = WorksheetFunction.CountA(rs.Offset(k))
                If wcount > 0 Then
                    rs.Value = rs.Offset(k).Value
                    rs.Offset(k).Value = ""
                    Exit Do
                End If
                k = k + 1
            Loop
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...in-range-to-top-and-move-empty-rows-down.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[123excel]

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px}</style>Hi Fluff and DanteAmor, I should of course have mention cross posting, sorry about that. I was in a hurry so I needed help fast due to a deadline. Will definitly tell about cross posting next time. Anyway I do really appreciate the help I got and togheter we actually got two solutions, which I will also paste here. The other alternative solution is from WideBoyDixon in the cross post here: https://www.excelforum.com/excel-pr...top-and-move-empty-rows-down.html#post5136240

Alternative code:

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Public Sub MoveTextUp(ByRef oRange As Range)

Dim thisRow As Long
Dim rowOffset As Long
Dim lastRow As Long

lastRow = oRange.Rows.Count
rowOffset = lastRow
thisRow = 1
Do While thisRow <= lastRow
If oRange.Cells(thisRow, 1).Value = "" Then
oRange.Cells(thisRow, 1).Resize(1, oRange.Columns.Count).Cut
oRange.Cells(thisRow, 1).Offset(rowOffset, 0).Insert shift:=xlDown
lastRow = lastRow - 1
Else
thisRow = thisRow + 1
rowOffset = rowOffset - 1
End If
Loop

End Sub</code>
His solution worked as it should so that is an alternative if someone would rather use that, but I found it more slow than DanteAmors solution, which is really fast and works perfect!

Thanks a lot DanteAmor for your help, I do really appreciate it and it helped me met the deadline!

 

[DanteAmor]

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px}</style>Hi Fluff and DanteAmor, I should of course have mention cross posting, sorry about that. I was in a hurry so I needed help fast due to a deadline. Will definitly tell about cross posting next time. Anyway I do really appreciate the help I got and togheter we actually got two solutions, which I will also paste here. The other alternative solution is from WideBoyDixon in the cross post here: https://www.excelforum.com/excel-pr...top-and-move-empty-rows-down.html#post5136240

His solution worked as it should so that is an alternative if someone would rather use that, but I found it more slow than DanteAmors solution, which is really fast and works perfect!

Thanks a lot DanteAmor for your help, I do really appreciate it and it helped me met the deadline!

I'm glad to help you. I appreciate your kind comments.