Question

I am having an array of 70000 elements(vb6) and I need to place the array as an excel column.
Since each excel sheet has row limit of 66k I can’t do it.

I tried selecting the range with multiple worksheets but I am getting error.

Answer 1

Updated Code #1

The code at top has been updated to

• clearly separate the creation of the sample 70K array from the the interaction with Excel
• to use two new arrays to separate the sample 70k array rather than one (note ObjExcel.Transpose can’t be used as a workaround to recuce the first dimension of the initial array as there are more than 65536 records in X)
• leave the automated Excel instance open at the end of the code
• test for the presence of at leat two Excel sheets (as per Doug’s comment)

I have added an alternative code that dumps the initial 70K to a worksheet, then sets the 30K and 40K directly from the worksheet without looping (see Updated Code #2)

     Sub SplicedArray2()
    Dim objExcel As Object
    Dim objWB As Object
    Dim X(1 To 70000, 1 To 1) As String
    Dim Y()
    Dim Z()
    Dim lngRow As Long
    Dim lngRow2 As Long
    Dim lngStart As Long

    'create intial 70K record array
    For lngRow = 1 To UBound(X, 1)
        X(lngRow, 1) = "I am record " & lngRow
    Next

    'records split size
    lngStart = 30000

    Set objExcel = CreateObject("excel.application")
    'creats a new excel file. You may wish to open an existing one instead
    Set objWB = objExcel.Workbooks.Add

    ReDim Y(1 To UBound(X, 1) - lngStart, 1 To 1)
    'Place records 30001 to 70000 from original array to second array
    For lngRow2 = 1 To UBound(Y, 1)
        Y(lngRow2, 1) = X(lngRow2 + lngStart, 1)
    Next lngRow2

    ReDim Z(1 To lngStart, 1 To 1)
    'Place records 1 to 30000 from original array to third array
    For lngRow2 = 1 To UBound(Z, 1)
        Z(lngRow2, 1) = X(lngRow2, 1)
    Next lngRow2

    'Test for presence of second sheet, add it if there is only one sheet
    If objWB.Sheets.Count < 2 Then objWB.Sheets.Add
    'Dump first set of records to sheet 1
    objWB.Sheets(1).[a1].Resize(UBound(Y, 1), UBound(Y, 2)) = Y
    ' Dump second set of records to sheet 2
    objWB.Sheets(2).[a1].Resize(UBound(Z, 1), UBound(Z, 2)) = Z
    objExcel.Visible = True

    'close file (unsaved)
    ' objWB.Close False
    ' objExcel.Quit
    ' Set objExcel = Nothing
    End Sub

Updated Code #2

    Sub OtherWay()
   'Works only in xl 07/10 if more than 65536 rows are needed
    Dim objExcel As Object
    Dim objWB As Object
    Dim objws As Object
    Dim lngRow As Long
    Dim lngStart As Long
    Dim X(1 To 70000, 1 To 1) As String
    Dim Y()
    Dim Z()

    Set objExcel = CreateObject("excel.application")
    'Add a single sheet workbook
    Set objWB = objExcel.Workbooks.Add(1)
    Set objws = objWB.Sheets.Add

    For lngRow = 1 To UBound(X, 1)
        X(lngRow, 1) = "I am record " & lngRow
    Next

    'records split size
    lngStart = 30000

    With objws.[a1]
        .Resize(UBound(X, 1), UBound(X, 2)).Value2 = X
        Y = .Resize(lngStart, UBound(X, 2)).Value2
        Z = .Offset(lngStart, 0).Resize(UBound(X, 1) - lngStart, UBound(X, 2)).Value2
        .Parent.Cells.ClearContents
    End With

    objWB.Sheets(1).[a1].Resize(UBound(Y, 1), UBound(Y, 2)) = Y
    objWB.Sheets(2).[a1].Resize(UBound(Z, 1), UBound(Z, 2)) = Z
    objExcel.Visible = True

    'close file (unsaved)
    ' objWB.Close False
    ' objExcel.Quit
    ' Set objExcel = Nothing
    End Sub

Original Code

Something like this will do it

1. The code creates an 60,000 record 2D array from the cells in A1:A6000
2. It then uses a second array to store the second half (30001 to 60000) of the records of the first array
3. The first half of the records in the original array (1 to 30000) are dumped to the first sheet (the remaining records are simply ignored as the Excel range is half the array size)
4. The second array is dumped to the second sheet

The code below uses INT() to handle arrays with odd records
ie 60001 records would be dumped

• record 1 to 30000 to sheet1
• records 30001 to 60001 to sheet 2

[Update code to show automation of Excel]

    Sub SplicedArray()
    Dim objExcel As Object
    Dim objWB As Object
    Dim X()
    Dim Y()
    Dim lngRow As Long
    Dim lngStart As Long

    Set objExcel = CreateObject("excel.application")
    'creats a new excel file. You may wish to open an existing one instead
    Set objWB = objExcel.Workbooks.Add

    'create 60000*1 array from column A
    X = objWB.Sheets(1).Range("A1:A60000").Value2

    'determine if second array needs X/2+1 records for an odd sized array
     If UBound(X, 1) Mod 2 <> 0 Then
        ReDim Y(1 To Int(UBound(X, 1) / 2) + 1, 1 To 1)
    Else
        ReDim Y(1 To Int(UBound(X, 1) / 2), 1 To 1)
    End If

    'loop from 30001 to 60000
    For lngRow = Int(UBound(X, 1) / 2) + 1 To UBound(X, 1)
        ' put value of row 30001 column 1 into row 1 column 1 of second array
        ' ......
        ' put value of row 60000 column 1 inro row 30000 column 1 of second array
        Y(lngRow - Int(UBound(X, 1) / 2), 1) = X(lngRow, 1)
    Next lngRow
    ' Dump first half of records from orginal array to sheet 1
    objWB.Sheets(1).[a1].Resize(Int(UBound(X, 1) / 2), UBound(X, 2)) = X
    ' Dump second half of records from new array to sheet 2
    objWB.Sheets(2).[a1].Resize(UBound(Y, 1), UBound(Y, 2)) = Y

    'close file (unsaved)
    objWB.Close False
    objExcel.Quit
    Set objExcel = Nothing
    End Sub