Search for next empty cell

Question

I want to copy data in certain cells to another sheet in a table.

My code copies the data and searches for the cell to be pasted to. If there is a value in the destination cell, it is looped to check the subsequent rows in the same column until it finds an empty cell.
If there's 2000 rows of data currently in the table, it will search all 2000 cells before landing in the 2001st row.

The amount of time taken to execute the code is affected by the size of the table.

Is there any way to execute faster?

Below is a sample, its copying data from two cells.

Sub Test()
    Sheets("Sheet1").Select
    Range("K10").Select
    Selection.Copy
    Sheets("Table").Select
    Range("A2").Select
    Do While Not (ActiveCell.Value = "")
        ActiveCell.Offset(1, 0).Activate
    Loop
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Sheets("Sheet1").Select
    Range("G15").Select
    Selection.Copy
    Sheets("Table").Select
    Range("B2").Select
    Do While Not (ActiveCell.Value = "")
        ActiveCell.Offset(1, 0).Activate
    Loop
End sub

[Avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/) — BruceWayne, Dec 11 '18 at 03:16
Hello, please help me to understand why I need to avoid these. — hans smith, Dec 11 '18 at 03:47
The "Why" is well explained in the link @BruceWayne provided — Display name, Dec 11 '18 at 03:54

score 2 · Accepted Answer · answered Dec 11 '18 at 03:16

2

Try following sub.

Sub CopyPaste()
Dim sht1, sht2 As Worksheet

Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Table")

    sht1.Range("K10").Copy sht2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    sht1.Range("G15").Copy sht2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

End Sub

answered Dec 11 '18 at 03:16

Harun24hr

30,391
4
21
36

Hello @Harun24HR, thank you for your help. Is there anyway to just paste the value alone into the destination cell without affecting the cell's format? Also, if i selected a range such as "K10:K15", how can i transpose it without affecting the cell's format? – hans smith Dec 12 '18 at 08:16
Then you have to use match destination format. Better you can ask a separate question like how to paste cells keeping destination format? – Harun24hr Dec 12 '18 at 08:20
Is it possible to incorporate it into the code you provided? I tried my original "Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False" but to no avail – hans smith Dec 12 '18 at 08:30

score 0 · Answer 2 · answered Dec 11 '18 at 03:31

It's unclear on whether you expect to find interim blank cells within the worksheet's used range or whether you expect to always put the new values at the bottom of the used range. This should work for both scenarios.

Sub Test()

    Dim ws1 As Worksheet

    Set ws1 = Worksheets("sheet1")

    With Worksheets("table")
        'force a definition for a .UsedRange on the worksheet
        .Cells(.Rows.Count, "A") = Chr(32)
        .Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1) = ws1.Cells(10, "K").Value
        .Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1) = ws1.Cells(15, "G").Value
        'clear the artificial .UsedRange
        .Cells(.Rows.Count, "A").Clear
        'Debug.Print .UsedRange.Address(0, 0)
    End With

End Sub

Search for next empty cell

2 Answers2