Selecting only Cells with Value VBA

Question

I have the code below and works fine, but I only want to copy cells with Values. I have blank data in the middle, as I will delete that does not make sense to copy them too.

Sub FindAgain()
'
' FindAgain Macro
'
    Dim Ws As Worksheet
    Dim LastRow As Long

    AC = ActiveCell.Column
    Set Ws = Worksheets("Sheet1")
    LastRow = Ws.Cells(Rows.Count, "B").End(xlUp).Row
    Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Select
    Range(ActiveCell, Cells(LastRow, AC)).Select

End Sub

Any idea how I can better write it? With Loop maybe? Thanks!

Did you look at: http://stackoverflow.com/questions/5338725/copy-a-range-of-cells-and-only-select-cells-with-data or http://stackoverflow.com/questions/13351245/copy-a-range-of-cells-and-only-select-cells-with-data-and-just-the-value-not-the Both show examples you could use. — Wayne G. Dunn, Nov 22 '16 at 19:31

Logan Reed · Accepted Answer · 2016-11-23T03:02:46.027

1

I assume that after Range(ActiveCell, Cells(LastRow, AC)).Select you see a region selected that you want to copy ignoring blank cells. One way to go about it is to iterate over all the cells in Selection, check if they are not empty and copy them:

Dim c As Range
Dim i As Long

' store current row for every column separately
Dim arrRowInCol() As Long
ReDim arrRowInCol(Selection.Column To Selection.Column + Selection.Columns.Count - 1)
For i = LBound(arrRowInCol) To UBound(arrRowInCol)
    ' init the first row for each column
    arrRowInCol(i) = Selection.Row
Next i

For Each c In Selection
    If Len(Trim(c)) <> 0 Then
        c.Copy Destination:=Sheets("Sheet2").Cells(arrRowInCol(c.Column), c.Column)
        arrRowInCol(c.Column) = arrRowInCol(c.Column) + 1
    End If
Next c

edited Nov 23 '16 at 03:02

answered Nov 22 '16 at 19:43

Logan Reed

882
7
13

That is very close of what I want. what happens with your piece is that, when it goes again, the blank line remains below, because and the data again below the blank.. so lets say, it keeps 1 blank 4 blank blank 5, what I want is to paste the data below each other 1 4 5 etc – Leandro Moreira Nov 22 '16 at 20:07
I've updated the code to store current row for each column separately. You only increment it when you paste - so it effectively collapses every column on empty values. See if this works. – Logan Reed Nov 23 '16 at 02:58

score 1 · Answer 2 · answered Nov 22 '16 at 20:40

Found a way to do what I want: At least is working, i am newby so, for you guys may seem funny or bad, for me is great =D

Sub FindAgain()
'
' FindAgain Macro
'
Dim Ws As Worksheet
Dim LastRow As Long
Dim c As Range
Dim i As Integer
Dim j As Integer

AC = ActiveCell.Column
Set Ws = Worksheets("Sheet1")
LastRow = Ws.Cells(Rows.Count, "B").End(xlUp).Row
i = 15
j = 7
Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, Cells(LastRow, AC)).Select

For Each c In Selection
    If Len(Trim(c)) <> "" Then
        c.Copy Destination:=Sheets("Sheet1").Cells(i, j)
    End If

    If c = "" Then
    i = i
    Else
    i = i + 1
    End If
    j = j

Next c

End Sub

score 0 · Answer 3 · answered Nov 22 '16 at 19:56

I will start with your code, which actually tries to select the ranges. This is what I have built upon it:

Option Explicit

Public Sub FindMe()

    Dim my_range            As Range
    Dim temp_range          As Range

    Dim l_counter           As Long
    Dim my_list             As Object
    Dim l_counter_start     As Long


    Set my_list = New Collection

    l_counter_start = Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Row + 1

    For l_counter = l_counter_start To Worksheets("sheet1").Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(l_counter, 2) <> "" Then my_list.Add (l_counter)
    Next l_counter

    For l_counter = 1 To my_list.Count
        Set temp_range = Range(Cells(my_list(l_counter), 2), Cells(my_list(l_counter), 4))

        If my_range Is Nothing Then
            Set my_range = temp_range
        Else
            Set my_range = Union(my_range, temp_range)
        End If
    Next l_counter

    my_range.Select

End Sub

It works upon a scenario like this:

Pretty much it works like this:

We declare two ranges.
The range my_range is the one to be selected at the end.
The range temp_range is only given, if there is a value in the second column.
Then there is a union of both ranges, and my_range is selected at the end of the code.

Selecting only Cells with Value VBA

3 Answers3