Find cells of certain length and copy to current worksheet

Question

I have an excel file with 2 worksheets.

In worksheet 1 i want to end up with a list of all the cells in worksheet 2 that are 12 digits long and the cell on the right of those.
I want the actual cell (the one with 12 digits) in (lets say) I1 on my worksheet 1, and the value next to it (on the right) in I2.

I thought/assumed i could do this with a loop to check what cells are 12 digits long but i kinda got lost.

After some more searching i came up with this:

Sub check()
Dim rng As Range, cell As Range

Set rng = Range("A1:P35")

For Each cell In rng

If Len(cell) = 12 Then
    cell.Copy Destination:=Sheet2(s).Rows(K)
    Row = K + 1

End If

Next cell

End Sub

Would this idea work? I just havent figured out yet how to actually copy the found cell into the other worksheet.

Why use a loop and not autofilter? [THIS](http://superuser.com/questions/203521/how-to-filter-excel-data-by-text-length) and [THIS](http://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s) will get you started. — Siddharth Rout, Sep 06 '15 at 11:50
Because i first have to find where they are on the worksheet (not always same location) and then copy them to the new worksheet. This wont work with just a filter i guess? — Elmer, Sep 06 '15 at 11:58
You can loop through the columns and apply the autofilter? That ways you can take care of the entire column in one go :) — Siddharth Rout, Sep 06 '15 at 12:05
@SiddharthRout In this specific context a loop should be OK. Also it is much more adaptable than a filter and, at a first sight, it seems that the requested requirements might change appreciably at some point. — varocarbas, Sep 06 '15 at 12:11
@varocarbas If there are 16 columns and each column has 100 such numbers so if you are ok with looping (16*100 = 1600 times) then I leave the choice to you. If you are using Autofilter then you will have to loop only 16 times :) — Siddharth Rout, Sep 06 '15 at 12:14
I wrote various links to a benchmark showing the advantage of using memory (= arrays) with respect to directly accessing Excel cells (i.e., 8s for 100K records; and my conclusion: for a few thousands doesn’t matter) which have been deleted!? Note that this comparison was relevant here because of a discussion in one of the answers below (these comments have also been deleted; but this is quite logical as far as the tone of that conversation was quite offtopic). Sorry for the person who was so nice to provide relevant data to support our (= memory is certainly faster) abstract impressions. — varocarbas, Sep 07 '15 at 07:24

score 3 · Accepted Answer · answered Sep 06 '15 at 13:32

For a single column I'd use an Autofilter (which Sid recommended) or an Evaluate formula, for a 2D range I'd prefer a variant. Something like:

Sub UseVariants()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim X
Dim Y
Dim lngRow As Long
Dim lngCol As Long
Dim lngCnt As Long

Set ws1 = Sheets(1)
Set ws2 = Sheets(2)

X = ws2.Range(ws2.[a1], ws2.[q35]).Value2
ReDim Y(1 To UBound(X, 1) * UBound(X, 2), 1 To 2)

For lngRow = 1 To UBound(X, 1)
    'skip column Q
    For lngCol = 1 To UBound(X, 2) - 1
        If Len(X(lngRow, lngCol)) = 12 Then
            lngCnt = lngCnt + 1
            Y(lngCnt, 1) = X(lngRow, lngCol)
            Y(lngCnt, 2) = X(lngRow, lngCol + 1)
        End If
    Next
Next

ws1.[i2].Resize(UBound(Y, 1), 2).Value2 = Y
End Sub

Vasily · Answer 2 · 2015-09-06T14:36:59.840

try this:

Sub Test()
    Dim rng As Range, cl As Range, dic As Object, key, Rw&
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set dic = CreateObject("Scripting.Dictionary")
    Set ws1 = Sheets("Source"): Set ws2 = Sheets("Destination")
    Rw = 1
    With ws1
        Set rng = .[A1:P35]
        For Each cl In rng
            If Len(cl) = 12 Then
                dic.Add Rw, cl.Text & "|" & cl.Offset(, 1).Text '.text can be replaced by .value or omitted, depending on your needs
                Rw = Rw + 1
            End If
        Next cl
    End With
    Rw = 1 'insert starting from row 1, change it if required
    With ws2
        For Each key In dic
            .Cells(Rw, "A") = Split(dic(key), "|")(0) 
            .Cells(Rw, "B") = Split(dic(key), "|")(1)
            Rw = Rw + 1
        Next key
    End With
    Set dic = Nothing
End Sub

Find cells of certain length and copy to current worksheet

2 Answers2