Loop through cells; Copy if not blank; Paste in sheet2 unformatted

Question

I've been sitting with this problem for a few hours and would be very thankful if anyone here could assist me.

What I want to do:

For all cells A10:A180 in sheet1
If cell contains a date on the form YYYY-MM-DD
Copy cell and the two next cells to the right (e.g. A11:A13)
Remove all formatting, so as to only copy the value/string of the cell.
Paste at end of column in sheet2
When finished, sort the entries (whole row) by date

Any thoughts?

Best regards Dean

Edit: copy&pasted code from comments:

Private Sub Worksheet_Activate() 
    Sheet2.Cells.Clear 
    Dim R1 As Range, R2 As Range 
    Dim wsFrom As Worksheet, wsTo As Worksheet 
    Set wsFrom = ThisWorkbook.Sheets("Blad1") 
    Set wsTo = ThisWorkbook.Sheets("Blad2") 
    Set R1 = wsFrom.Range("A:B") 
    Set R2 = wsTo.Range("A:B") 
    R1.Copy R2 
End Sub

what have you tried? and do you want to copy the date value as a plain number 42005, the value formatted as a date 2015-01-01 or to convert it to a string "2015-01-01" and change the number format in output range as text? — Aprillion
I want the value formatted as date, so I can sort it by date in sheet2. This is the basic outline of what I've tried, but it doesn't at all follow my algorithm above. I'm very new to VBA. Private Sub Worksheet_Activate() Sheet2.Cells.Clear Dim R1 As Range, R2 As Range Dim wsFrom As Worksheet, wsTo As Worksheet Set wsFrom = ThisWorkbook.Sheets("Blad1") Set wsTo = ThisWorkbook.Sheets("Blad2") Set R1 = wsFrom.Range("A:B") Set R2 = wsTo.Range("A:B") R1.Copy R2 End Sub — dean
please edit your own question for pasting code, I copy&pasted your code for now, so you can see how to make code formatting — Aprillion
by 2 cells to the right, instead of A11:A13 do you mean A10:C10? — Aprillion
also what do you mean by the end of column in sheet2 please? value from cell A10 should be pasted where for example? — Aprillion

Aprillion Aprillion · Accepted Answer · 2015-01-16T14:42:36

There are some unclear points in your question, but following code should get you started how to properly load, manipulate and paste values between ranges using VBA arrays:

Option Explicit

Sub copy_nonblank()
    Dim data() As Variant  ' () creates an array instead of a simple variable
    Dim row_count, col_count, r, c, shift As Integer

    'load data from specified range into an array
    data = ThisWorkbook.Sheets("Blad1").Range("A10:C180").Value2

    ' iterate through rows and shift data up to fill-in empty rows
    row_count = UBound(data, 1)
    col_count = UBound(data, 2)
    shift = 0
    For r = 1 To row_count
        If IsEmpty(data(r, 1)) Then
            shift = shift + 1
        ElseIf shift > 0 Then
            For c = 1 To col_count
                data(r - shift, c) = data(r, c)
            Next c
        End If
    Next r

    ' delete values, but not formatting
    ThisWorkbook.Sheets("Blad2").Cells.ClearContents

    ' paste special as values, but only the shifted non-empty rows
    ThisWorkbook.Sheets("Blad2").Range("A10") _
        .Resize(r - shift - 1, col_count) _
        .Value2 = data
End Sub

You will need to specify the formatting on the output sheet manually, but only once.

Loop through cells; Copy if not blank; Paste in sheet2 unformatted

1 Answers