Need help fast w/ vba!

[nrguerrieri]

Need a macro that will find every cell that contains text within columns A to E all the way down to the bottom. Then paste them in that exact order, but all in column A.

 

[My Aswer Is This]

Try this:

Sub Search_Range()
'Modified 5/10/2018 7:30 PM  EDT
Application.ScreenUpdating = False
Dim c As Range
Dim Lastrow As Long
Dim i As Long
i = 1
Dim b As Long
    For b = 1 To 5
        Lastrow = Cells(Rows.Count, b).End(xlUp).Row
            For Each c In Cells(1, b).Resize(Lastrow)
                If c.Value <> "" Then
                ans = c.Row
                c.Copy Cells(ans, 1)
                End If
            Next
    Next
Application.ScreenUpdating = True
End Sub

 

[nrguerrieri]

Try this:

Sub Search_Range()
'Modified 5/10/2018 7:30 PM  EDT
Application.ScreenUpdating = False
Dim c As Range
Dim Lastrow As Long
Dim i As Long
i = 1
Dim b As Long
    For b = 1 To 5
        Lastrow = Cells(Rows.Count, b).End(xlUp).Row
            For Each c In Cells(1, b).Resize(Lastrow)
                If c.Value <> "" Then
                ans = c.Row
                c.Copy Cells(ans, 1)
                End If
            Next
    Next
Application.ScreenUpdating = True
End Sub

Thank you so much. that worked.

Now, im trying to do that last part. So copying from above and pasting below to all the blanks below until there is a value. then where there is a value. copy that and paste to all the blanks below that, and so on. I am getting an error for some reason with my code below here.

Any clue why its not working?

Sub abc()

Dim lastRow
lastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For ptr = 2 To lastRow
If Cells(ptr, "A") = vbNullString Then
Cells(ptr, "A") = Cells(ptr, "A").Offset(-1, 0)
End If
Next

End Sub

 

[My Aswer Is This]

If you trying to look down column A.
And if some cell in column A is empty then enter cell value above
Try this:
If this is not what you want then explain more.

Sub abc()
'Modified 5/10/18 11:14 PM EDT
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim i As Long
    For i = 2 To Lastrow
        If Cells(i, "A") = vbNullString Then
            Cells(i, "A") = Cells(i, "A").Offset(-1, 0).Value
        End If
    Next
End Sub

 

[Rick Rothstein]

Try this:

Sub Search_Range()
'Modified 5/10/2018 7:30 PM  EDT
Application.ScreenUpdating = False
Dim c As Range
Dim Lastrow As Long
Dim i As Long
i = 1
Dim b As Long
    For b = 1 To 5
        Lastrow = Cells(Rows.Count, b).End(xlUp).Row
            For Each c In Cells(1, b).Resize(Lastrow)
                If c.Value <> "" Then
                ans = c.Row
                c.Copy Cells(ans, 1)
                End If
            Next
    Next
Application.ScreenUpdating = True
End Sub

Here is another macro to consider... it produces the same output as the macro above, but without using an loops.

[table="width: 500"]
[tr]
	[td]Sub Search_Range()
  With Range("A1:A" & Columns("B:E").Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row)
    .Formula = "=IFERROR(INDEX(OFFSET(B1,ROW(A$1:A$7)-1,0,1,5),MATCH(""*"",OFFSET(B1,ROW(A$1:A$7)-1,0,1,5),0)),"""")"
    .Value = .Value
  End With
End Sub[/td]
[/tr]
[/table]