dn920
asked on
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.
usachrisk1983
Could you post your code sample?
ASKER
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
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"
Kevin
Kevin
ASKER
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?
Perhaps...are you seeing the message ""Step One Is complete..." once or twice?
Kevin
Kevin
ASKER
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.
Can you describe more specifically what data is being replicated? Have you tried stepping through the code and watching each line execute?
Kevin
Kevin
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.