Solved

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

Posted on 2009-05-05
8
222 Views
Last Modified: 2012-05-06
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.
0
Comment
Question by:dn920
  • 4
  • 3
8 Comments
 
LVL 13

Expert Comment

by:usachrisk1983
ID: 24304726
Could you post your code sample?
0
 

Author Comment

by:dn920
ID: 24304763
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
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 24305293
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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 

Author Comment

by:dn920
ID: 24305335
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
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 24305364
Perhaps...are you seeing the message ""Step One Is complete..." once or twice?

Kevin
0
 

Author Comment

by:dn920
ID: 24305576
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
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 24306162
Can you describe more specifically what data is being replicated? Have you tried stepping through the code and watching each line execute?

Kevin
0
 

Accepted Solution

by:
dn920 earned 0 total points
ID: 24306866
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

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
WPF issue with Trigger 2 106
Protecting vb6 & .Net code Obfuscation 18 121
TT Auto Dashboard 13 92
Programatically extract date from website 8 77
This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
This article will show, step by step, how to integrate R code into a R Sweave document
This video will show you how to get GIT to work in Eclipse.   It will walk you through how to install the EGit plugin in eclipse and how to checkout an existing repository.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question