Solved

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

Posted on 2009-05-05
8
240 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

 

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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
IF ELSE Statement in Excel Macro VBA 16 103
sort Multi-dimensional array 6 45
Get the Y value of a line at X in a chart in VBA 28 74
Problem to macro 5 24
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
The viewer will learn how to user default arguments when defining functions. This method of defining functions will be contrasted with the non-default-argument of defining functions.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.

752 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