We help IT Professionals succeed at work.

Excel Line Limit

dn920
dn920 asked
on
I am using the following code to pull in several work books and copy a page out of them. I am using the new version of excel so we can go beyond the 65536 limit, however when we started we were limited by the old excel.

Is it possible to modify this code to go to the bottom no matter what line? I have tried to change the code to a larger number but it debugs each time.


Option Explicit
 
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim Lastrow As Long
Dim Firstrow1 As Long
Dim LastRow1 As Long
Dim Lrow1 As Long
Dim myRange As Range

Sub CompileAllChecksInFolder()
    Application.ScreenUpdating = False
    ChDrive ActiveWorkbook.Path
    ChDir ActiveWorkbook.Path
    ToBook = ActiveWorkbook.Name
    '---------------------------
    '- MASTER SHEET
    '---------------------------
    Set ToSheet = ActiveSheet
    NumColumns = ToSheet.Range("A1").End(xlToRight).Column
    ToRow = ToSheet.Range("A65536").End(xlUp).Row
    If ToRow <> 1 Then
        ToSheet.Range(ToSheet.Cells(2, 1), _
            ToSheet.Cells(ToRow, NumColumns)).ClearContents
    End If
    ToRow = 3
    '------------------------------------------
    '- main loop to open each file in folder
    '------------------------------------------
    FromBook = Dir("*.xls")
    While FromBook <> ""
        If FromBook <> ToBook Then
            Application.StatusBar = FromBook
            Transfer_data   ' subroutine below
        End If
        FromBook = Dir
    Wend

Set myRange = Range("B2", Range("B65536").End(xlUp))
myRange.Select
Application.ScreenUpdating = True
MsgBox ("I am going to clean up the data now, this may take several minutes.......")
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "PO Number"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Invoice Number"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "DC number"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Store Number"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Division"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Microfilm Number"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "Invoice Date"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "Invoice Amount"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "Date Paid"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "Discount"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "Amount Paid"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "Deduction Code"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "Combined Deduction"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "Payment"
    Range("A2:N2").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Underline = False
    End With
    Selection.Font.Bold = True
    Range("A2").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    With Selection.Font
        .Underline = False
        .Name = "Arial"
        .Size = 8
    End With
    Range("A2").Select
    Application.CutCopyMode = False
Application.ScreenUpdating = True

MsgBox ("Step One Is complete, validate information and go on to step 2")



End Sub

Private Sub Transfer_data()
    Workbooks.Open FileName:=FromBook
       'For Each FromSheet In Workbooks(FromBook).Worksheets
           'Sheets("Sheet1").Select
       Set FromSheet = Workbooks(FromBook).Worksheets("Sheet1")
          Lastrow = FromSheet.Range("A65536").End(xlUp).Row
             
        '-----------------------------------------------------
        '- copy/paste to master sheet
        FromSheet.Range(FromSheet.Cells(3, 1), _
        FromSheet.Cells(Lastrow, NumColumns)).Copy _
        Destination:=ToSheet.Range("A" & ToRow)
        '-----------------------------------------------------
        '- set next ToRow
        ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
    'Next
    Workbooks(FromBook).Close SaveChanges:=False
End Sub

Open in new window

Comment
Watch Question

Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
Give this a try and see if it works, although there may be a better way.

ToRow = ToSheet.Range("A1").Offset(ToSheet.Rows.Count - 1, 0).End(xlUp).Row

Open in new window

~bp

Author

Commented:
Bill that works, however I am getting stopped up at the next section which it calls the from sheet, and it has the same range limit, can I do the same thing here?
Private Sub Transfer_data()
    Workbooks.Open Filename:=FromBook
       'For Each FromSheet In Workbooks(FromBook).Worksheets
           'Sheets("Sheet1").Select
       Set FromSheet = Workbooks(FromBook).Worksheets("Sheet1")
          Lastrow = FromSheet.Range("A65536").End(xlUp).Row
             
        '-----------------------------------------------------
        '- copy/paste to master sheet
        FromSheet.Range(FromSheet.Cells(3, 1), _
        FromSheet.Cells(Lastrow, NumColumns)).Copy _
        Destination:=ToSheet.Range("A" & ToRow)
        '-----------------------------------------------------
        '- set next ToRow
        ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
    'Next
    Workbooks(FromBook).Close SaveChanges:=False
End Sub

Open in new window

Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Yes, where ever you were using that approach you should be able to update it to the different approach.

~bp

Author

Commented:
Thanks, I knew there had to be a way just wasn't sure how to get there. Appreicate your help!
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Great, glad that helped, thanks for the feedback.

~bp

Explore More ContentExplore courses, solutions, and other research materials related to this topic.