Excel macro - Iteratively copy rows from one sheet to another

Question

There are 3 sheets in a workbook: Sheet1, Sheet2, Sheet3. Sheet1 has the following data:

aaa    3
aaa    2
aaa    45
aaa    211
aaa    12
bbbb   3
bbbb   2
bbbb   4
ccc    2
ccc    5
dddd   2
dddd   10
dddd   25

There will be a hash table like this:

key        values
GroupA     aaa, bbbb
GroupB     ccc, dddd

How can I load data to the other sheets Sheet2 and Sheet3 such that Sheet2 contains all rows with 'GroupA' and Sheet3 has all rows with 'GroupB' present in Sheet1, using a macro subroutine?

EDIT:
I would like to use a hashtable kind of a structure for storing GroupA, GroupB, etc. with their values and iteratively process sheet1 accordingly, w.r.t each Group.

Do you really need to do it in the way you suggest? Perhaps if you are more specific about what you want to accomplish, someone can suggest a more elegant solution than you've envisioned so far. — Kimball Robinson

Fionnuala Fionnuala · Accepted Answer · 2010-08-18T09:05:02

You can use ADO.

Dim cn As Object
Dim rs As Object
Dim rs2 As Object
Dim sFile As String
Dim sCon As String
Dim sSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

sFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rs2 = CreateObject("ADODB.Recordset")


cn.Open sCon

sSQL = "SELECT Key, [Values] " _
       & "FROM [Sheet2$] "

rs.Open sSQL, cn, 3, 3

i = 3
Do While Not rs.EOF

    sSQL = "SELECT Key, [Values] " _
           & "FROM [Sheet1$] " _
           & "WHERE '" & rs![Values] _
           & "' Like '%' & Key & '%' "

    rs2.Open sSQL, cn, 3, 3

    ''Pick a suitable empty worksheet for the results
    ''Worksheets.Add
    With Worksheets("Sheet" & i)
        .Cells(1, 1) = rs!Key

        For j = 0 To rs.Fields.Count - 1
            .Cells(2, j + 1) = rs.Fields(j).Name
        Next

        .Cells(3, 1).CopyFromRecordset rs2
    End With

    rs.MoveNext
    i = i + 1
    rs2.Close
Loop

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

Excel macro - Iteratively copy rows from one sheet to another

2 Answers