Solved: I have exceeded Excel’s limit of 1048576 rows while importing data from a file

[trpkob]

I have exceeded Excel’s limit of 1048576 rows while importing data from a file into it. I have the code below. I want a modification made so that once A1048576 is reached that the import continues in row B and once B1048576 is reached that it imports in C.
Sub Button1_Click()
Dim intFileNum%, bytTemp As Byte, intCellRow, fn As String
fn = Worksheets("Automated_Logistics_Macro").Range("F4").Value2
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub

SpeedOn

intFileNum = FreeFile
intCellRow = 1
Open fn For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum

EndSub:
SpeedOff
End Sub
Sub ken()
Dim fn As String, s As String

fn = "w:\ken.wpd"
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub

SpeedOn

s = FileLoad(fn)
Range("A1").Resize(UBound(Split(s, vbLf))).Value = WorksheetFunction.Transpose(Split(s, vbLf))

EndSub:
SpeedOff
End Sub

'Purpose : Returns the contents of a file
'Inputs : sFileName The path and file name of the file to open and read
'Outputs : The contents of the specified file

Function FileLoad(ByVal sFileName As String) As String
Dim iFileNum As Integer, lFileLen As Long

On Error GoTo ErrFinish
'Open File
iFileNum = FreeFile
'Read file
Open sFileName For Binary Access Read As #iFileNum
lFileLen = LOF(iFileNum)
'Create output buffer
FileLoad = String(lFileLen, " ")
'Read contents of file
Get iFileNum, 1, FileLoad

ErrFinish:
Close #iFileNum
On Error GoTo 0
End Function
Sub snb()
Dim fn As String, c01 As String, j As Long

fn = "w:\ken.wpd"
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub

SpeedOn

Open fn For Binary As #1
c01 = Input(LOF(1), #1)
Close

For j = 1 To Len(c01)
Cells(j, 1) = Mid(c01, j, 1)
Next j

EndSub:
SpeedOff
Public glb_origCalculationMode As Integer

Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
End Sub
Sub SpeedOff()
With Application
.Calculation = glb_origCalculationMode
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub
Sub FillSlow()
Dim c As Range, r As Range, startTime, EndTime
Set r = Range("A1:C1000")
r.ClearContents
startTime = Timer
For Each c In r
c.Select
c.Formula = "=Row()*Column()"
Next c
DoEvents
EndTime = Timer

MsgBox "Total Time: " & EndTime - startTime
[A1].Select
End Sub
Sub FillFast()
Dim c As Range, r As Range, startTime, EndTime
Set r = Range("A1:C1000")
r.ClearContents
startTime = Timer

On Error GoTo ResetSpeed
SpeedOn

For Each c In r
c.Select
c.Formula = "=Row()*Column()"
Next c
DoEvents
EndTime = Timer

MsgBox "Total Time: " & EndTime - startTime
[A1].Select

ResetSpeed:
SpeedOff
End Sub

[snb]

If you restrict the writing frequency to once you won't need any speeding or unspeeding code; so this will suffice:


Sub snb()
c00 = "w:\ken.wpd"
If Dir(c00) = "" Then
MsgBox "File does not exist:" & vbLf & c00, vbCritical, "Macro Ending"
Exit Sub
End If

Open c00 For Binary As #1
c01 = Input(LOF(1), #1)
Close

redim sn(1400000, len(c01) \1400000)
For j = 0 To Len(c01)-1
sn(j mod 1400000,j\1400000)= Mid(c01, j+1, 1)
Next

sheet1.cells(1).resize(ubound(sn)+1,Ubound(sn,2)+1)=sn
end sub

[mohanvijay]

Try this


Dim Rw_Ct As Long, Cl_Ct As Integer
Rw_Ct = 1
Cl_Ct = 1
Open fn For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)

If Rw_Ct > 1048576 Then
Rw_Ct = 1
Cl_Ct = Cl_Ct + 1
End If
Get intFileNum, , bytTemp
Cells(Rw_Ct, Cl_Ct) = bytTemp
Rw_Ct = Rw_Ct + 1

Loop
Close intFileNum

[trpkob]

Thank you very much mohanvijay, that worked exactly as I wanted it to!