VBA PROBLEM - Macro is copying everything twice, what am I missing?

Using the code below I am opening all the books in a directory, going to sheet one, starting at the 2nd row and copying everything. For some reason its going through and doing it twice. Can someone tell me what I am missing? Sometimes there 30 or more files, sometimes less, but it loops through looks like its fine then I end up with double the data.
dn920Asked:
Who is Participating?
 
dn920Author Commented:
What it does is:

LINE A
LINE B

When you read the sheet after the macro is finished you get

LINE A
LINE B
LINE A
LINE B

Trying to step through it to see what I am missing.
0
 
usachrisk1983Commented:
Could you post your code sample?
0
 
dn920Author Commented:
Sorry about that here is the code
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
    
'Adding the headers
    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
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Columns("A:A").ColumnWidth = 12.57
    Columns("B:B").ColumnWidth = 10.14
    Columns("B:B").ColumnWidth = 11.14
    Columns("B:B").ColumnWidth = 14.14
    Columns("B:B").ColumnWidth = 13.43
    Columns("B:B").ColumnWidth = 12.57
    Columns("C:C").ColumnWidth = 9.14
    Columns("D:D").ColumnWidth = 9.57
    Columns("D:D").ColumnWidth = 10.57
    Columns("D:D").ColumnWidth = 11.57
    Columns("E:E").ColumnWidth = 9.71
    Columns("E:E").ColumnWidth = 6.57
    Columns("F:F").ColumnWidth = 11.86
    Columns("F:F").ColumnWidth = 13.57
    Columns("F:F").ColumnWidth = 15.29
    Columns("G:G").ColumnWidth = 11
    Columns("H:H").ColumnWidth = 10.57
    Columns("K:K").ColumnWidth = 10
    Columns("L:L").ColumnWidth = 15.43
    Columns("L:L").ColumnWidth = 20.71
    Range("M1").Select
    Columns("L:L").ColumnWidth = 25.29
    Columns("L:L").ColumnWidth = 31.71
 
 
'Get Rid of formulas
Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 
 
Range("A2").Select
 
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

0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
zorvek (Kevin Jones)ConsultantCommented:
I do not see how the code provided above can copy the data twice. Is there more code than is displayed above? How is the routine "CompileAllChecksInFolder" called?

Kevin
0
 
dn920Author Commented:
Compile All checks in folder is called by pressing a button I created on the top of the sheet. And thats all the code, is it possible the button is seeing it clicked twice so going through it twice?
0
 
zorvek (Kevin Jones)ConsultantCommented:
Perhaps...are you seeing the message ""Step One Is complete..." once or twice?

Kevin
0
 
dn920Author Commented:
Just ran it again both by the button, and then by calling it from the macros list, I only see the message once, and I turned on screen updating, and it appears that its only opening the files once.
0
 
zorvek (Kevin Jones)ConsultantCommented:
Can you describe more specifically what data is being replicated? Have you tried stepping through the code and watching each line execute?

Kevin
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.