trpkob
07-20-2012, 11:17 AM
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
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