Trying to copy data from a .xls workbook into a .xlsm one while generating data

Question

I am trying to loop through one column of a .xls workbook. Each row of that one column has data that needs to be copied over to the new .xlsm workbook while auto-generating strings I've made (name, descriptions, etc). I tried my solution which is listed below, but I get a 1004 error and I can't figure out how to proceed. I am quite new to VBA so any pointers would be appreciated.

Some problems that I see or might need to be solved are as follows;

• Error 1004 (app defined or object defined error). The error is occurring inside the if statement < .Range(Cells((x+1) etc. >
• When I copy over the data from one row in the .xls workbook it fills up two rows (on purpose) for the new .xlsm workbook. So I need to be able to accommodate an extra row every time I copy data. That's why I have x = x + 1 in the for loop.
• For some of the data in the rows of the .xls workbook that I'm copying over, they have 2 or 3 pieces of data that need to be parsed into subsets of 2. So for most of the workbook it's 1 piece of data that gets turned into 2 rows in the new doc., but if it's 2 pieces of data > 4 rows, etc.

TL;DR - How do I get past this error and how can I make my code better to successfully copy the data over from the other workbook when iterating through a single column.

Anyways, here is the code:

Sub TestThis()

    Dim wb As Workbook
    Dim x As Integer

    Application.ScreenUpdating = False
    Set wb = Workbooks.Open("C:\Users\blah\Documents\blah\Week 02\old file.xls", True, True)

    With ThisWorkbook.Worksheets("template")
        NumRows = wb.Sheets(1).Range("T9:T1116").Rows.Count
        Range("T9:T1116").Select
        For x = 1 To NumRows
            If ActiveCell.Formula <> "" Then
                .Range(Cells(x, 2)).Formula = "field 1"
                .Range(Cells(x, 5)).Formula = "field 2"
                .Range(Cells(x, 7)).Formula = "a sentence is here but is replaced"
                .Range(Cells(x, 9)).Formula = "1"
                .Range(Cells(x, 10)).Formula = "blah blah blah data"
                .Range(Cells(x, 11)).Formula = "blah blah blah more data"
                .Range(Cells((x + 1), 9)).Formula = "2"
                .Range(Cells((x + 1), 10)).Formula = "Data in " + ActiveCell.Formula + " is stored in blah"
                .Range(Cells((x + 1), 11)).Formula = "Data is stored in blah"
            End If
            x = x + 1
            ActiveCell.Offset(1, 0).Select
        Next
    End With

    wb.Close False
    Set wb = Nothing
    Application.ScreenUpdating = True

End Sub

Answer 1

why not use ADO and treat the source datasheet as a db table. This would avoid a loop entirely and you could still auto-generate strings

References:

• MS Technet [Office Space]: Using ADO to Query an Excel Spreadsheet
• MS Knowledge Base: How To Use ADO with Excel Data from Visual Basic or VBA
• MSDN Library (Scripting Clinic): Much ADO About Text Files

Essentially, you connect to your Excel file using ADO and OLE DB Jet Driver:

Dim cn as ADODB.Connection
Set cn = New ADODB.Connection
With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=C:\MyFolder\MyWorkbook.xls;" & _
"Extended Properties=Excel 8.0;"
    .Open
End With

Next, now that you have an an ADO Connection you can use it to create an ADO Recordset:

objRecordset.Open "Select * FROM [Sheet1$]", _
    objConnection, adOpenStatic, adLockOptimistic, adCmdText

N.B Notice the [SHEET NAME$] - each sheet is a table!

Your Query: You can customize your query to include column/fields names and auto-generate your strings, a Where clause and even add derived columns that put formulas into the worksheet.

Alternatively you could dump the data in, then use VBA to add your formulas programmatically and for hundreds or throusands of rows in one step.

Once you have your recordset open, you can then use the CopyFromRecordset method of the Range Object to dump your recordset into a cell in your target worksheet in one step

Answer 2

I would start by not iterating through all the cells in the column oddly enough. Get the data inside vba, then loop and manipulate from there. So something like;

Dim aInVar As Variant

'This captures all the data inside an input variant in one hit
aInVar = Sheets(1).Range("T9:T1116")

You can also create an output variant to pass stuff into as you parse the input variant:

Dim aOutVar As Variant
'This resizes it to twice the amount of rows as the original
ReDim aOutVar(1 To UBound(aInVar, 1) * 2, 1 To 1)

Once its in there, you can loop through the variant much easier. So;

Dim i As Integer

'Loop through the in variant, doing whatever to its values
For i = 1 To UBound(aInVar, 1)

    'test each field looking for whatever.
    Select Case aInVar(i, 1)
        Case "field 1"
            'do something here
            aOutVar(i * 2 - 1, 1) = aInVar(i, 1)
        Case "field 2"
            'do something different here, eg
            aOutVar(i * 2 - 1, 1) = Replace(aInVar(i, 1), "replaceStr", "replacementStr")
    End Select

Next i

Finally, you can just output the output variant you've created in one hit:

Sheets(2).Range(Cells(1, 1), Cells(UBound(aOutVar, 1), 1)) = aOutVar

Manipulating data inside of vba is miles quicker than looping and testing cells as you go- and its easier to control what you are doing to it. Plus, brings out my OCD when I see people looping through cells using 'Select' / 'Activate' :)

None of that is tested, but hopefully enough to get you going with a different approach.