Results 1 to 11 of 11
  1. #1
    New Lounger
    Join Date
    Aug 2014
    Posts
    6
    Thanks
    3
    Thanked 0 Times in 0 Posts

    copy/append select data from open workbook to closed workbook

    Hi all,

    I will keep this as simple as possible.

    I need a macro or VBA code to do the following...

    I have many users using a workbook of which they will add data. Once they have added the data, i need them to click a macro that will copy their data to a workbook located on our corporate G: drive. I would want their data to append to the end of the list as many users will be adding similar data. Obviously i need the macro to see if the file is already open for someone else and if so pause and retry several times. the name of the sheet on the opened file is "Flat File", while the name of the closed workbook is "Global Journal" with a sheet name of "Entry"
    The source data looks something like this...

    worksheet data.JPG

    Thank you for any help.

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,398
    Thanks
    208
    Thanked 832 Times in 765 Posts
    Reitz1,

    Welcome to the Lounge as a new poster.

    I think we need more information:
    1. Will the macro need to copy all the data or just the added data, e.g. will the data input users start with a blank sheet each time?
    2. How many data input users will you have?
    3. Would you be open to other approaches like having the master workbook poll the users at certain times to copy the data?


    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  3. The Following User Says Thank You to RetiredGeek For This Useful Post:

    reitz1 (2014-09-01)

  4. #3
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,284
    Thanks
    46
    Thanked 255 Times in 235 Posts
    Reitz,

    The following code will run when the user clicks a Transfer Data Button. The code first checks to see if Global Journal workbook is already opened.

    If it is not, the workbook will open and the data from "Flat File" will be appended to the "Entry" Sheet. Global Journal's changes will then be saved and then closed. A message indicating that Global Workbook was updated will display.

    If Global workbook is already opened (in use), the Transfer Data button's caption will change to "Saving....Please wait" and be disabled indicating the process of transferring data has been initiated. The code will continue to check every minute to see if the workbook has closed. When finally closed, the process above will take place, the message indicating "Global Workbook was updated" will be displayed, and the button's caption will return to "Transfer Data".

    1. Change FilePath to the full path of Global Journal. Must have worksheet called "Entry"
    2. Button on sheet "Flat File" named CommandButton1 with the caption "Transfer Data"
    3. Change the TimeValue to another period of time if desired
    4. Source Workbook named "Flat File.xlsm" with worksheet also called "Flat File". Place the code in Flat File.xlsm where indicated

    HTH,
    Maud

    Thanks to the unnamed author at Excel Tips.com for the FileAlreadyOpen function that checks exactly was it says.

    In a standard module:
    Code:
    Public Sub TransferData()
    '----------------------------------------------
    'DECLARE AND SET VARIABLES
    Dim FilePath As String
    Dim I As Integer, J As Integer
    FilePath = "E:\Global Journal.xlsx"
    '----------------------------------------------
    'CHECK IF GLOBAL JOURNAL OPEN
        '------------------------------------------
        'OPEN- SCHEDULE RECHECK
        If FileAlreadyOpen(FilePath) = True Then
            Application.OnTime Now + TimeValue("00:01:00"), "TransferData"
            Worksheets("Flat File").CommandButton1.Enabled = False
            Worksheets("Flat File").CommandButton1.Caption = "Saving... Please wait"
        '------------------------------------------
        'CLOSED- OPEN GLOBAL WORKBOOK AND COPY DATA
        Else:
            Workbooks.Open (FilePath)
            With Workbooks("Global Journal.xlsx").Worksheets("Entry")
            NewRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            Workbooks("Flat File.xlsm").Activate
            LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            For I = 2 To LastRow
                For J = 1 To 7
                    .Cells(NewRow, J) = Cells(I, J)
                Next J
            NewRow = NewRow + 1
            Next I
            End With
        '------------------------------------------
        'SAVE, AND CLOSE GLOBAL WORKBOOK
            Worksheets("Flat File").CommandButton1.Enabled = True
            Worksheets("Flat File").CommandButton1.Caption = "Transfer Data"
            Workbooks("Global Journal.xlsx").Close SaveChanges:=True
            MsgBox "Global Journal updated"
        End If
    End Sub
    
    
    Function FileAlreadyOpen(FullFileName As String) As Boolean
    'http://www.exceltip.com/files-workbook-and-worksheets-in-vba/determine-if-a-file-is-in-use-using-vba-in-microsoft-excel.html
    Dim f As Integer
        f = FreeFile
        On Error Resume Next
        Open FullFileName For Binary Access Read Write Lock Read Write As #f
        Close #f
        If Err.Number <> 0 Then
            FileAlreadyOpen = True
            Err.Clear
        Else
            FileAlreadyOpen = False
        End If
        On Error GoTo 0
    End Function
    In "Flat Files's" sheet module:
    Code:
    Private Sub CommandButton1_Click()
         TransferData
    End Sub

  5. The Following User Says Thank You to Maudibe For This Useful Post:

    reitz1 (2014-09-01)

  6. #4
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,284
    Thanks
    46
    Thanked 255 Times in 235 Posts
    Reitz,

    Once transferred, if you want the source data to clear and then close the source workbook, you will need to add the following lines (in blue) as the 3rd and 4th lines to the end in the code:

    Code:
    
        '------------------------------------------
        'SAVE, AND CLOSE GLOBAL WORKBOOK
            Worksheets("Flat File").CommandButton1.Enabled = True
            Worksheets("Flat File").CommandButton1.Caption = "Transfer Data"
            Workbooks("Global Journal.xlsx").Close SaveChanges:=True
            MsgBox "Global Journal updated"
            Range("A2:G" & LastRow).ClearContents  'ADD TO CLEAR SOURCE DATA
            Workbooks("Flat File.xlsm").Close SaveChanges:=True 'ADD TO SAVE AND CLOSE SOURCE WORKBOOK
        End If
    End Sub

  7. #5
    New Lounger
    Join Date
    Aug 2014
    Posts
    6
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Retired Geek.... post 2...The users will start w/ a blank sheet every time and they will add data in a simple format that then gets copied to the sheet in the above format.
    The data needing to be copied would be any data in the specified sheet. it could be more rows or less rows than the sample data provided.
    We currently could have up to 150 users entering data but presume it would be less as not all users would have data. Polling not good as the time of data entry will vary, and easier to have the user initiate the process.

    it would be nice to know the user name who entered the data as well, but i could probably get that into the data being copied in some manner.

    thanks again for the reply and help.
    Last edited by reitz1; 2014-09-01 at 10:32.

  8. #6
    New Lounger
    Join Date
    Aug 2014
    Posts
    6
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Maudibe, Post 3..

    Looking forward to giving this a shot to see how it works....thanks
    Last edited by reitz1; 2014-09-01 at 10:33. Reason: Identify recipitent

  9. #7
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,284
    Thanks
    46
    Thanked 255 Times in 235 Posts
    Reitz,

    Borrowing from RG, I amended the code to add in the user's name to the transfer in column 8. As before, the code will transfer as many lines that are present but I added in the code to clear and save the source workbook.

    Code:
    Public Sub TransferData()
    '----------------------------------------------
    'DECLARE AND SET VARIABLES
    Dim FilePath As String
    Dim I As Integer, J As Integer
    FilePath = "E:\Global Journal.xlsx"
    '----------------------------------------------
    'CHECK IF GLOBAL JOURNAL OPEN
        '------------------------------------------
        'OPEN- SCHEDULE RECHECK
        If FileAlreadyOpen(FilePath) = True Then
            Application.OnTime Now + TimeValue("00:01:00"), "TransferData"
            Worksheets("Flat File").CommandButton1.Enabled = False
            Worksheets("Flat File").CommandButton1.Caption = "Saving... Please wait"
        '------------------------------------------
        'CLOSED- OPEN GLOBAL WORKBOOK AND COPY DATA
        Else:
            Workbooks.Open (FilePath)
            With Workbooks("Global Journal.xlsx").Worksheets("Entry")
            NewRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            Workbooks("Flat File.xlsm").Activate
            LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            For I = 2 To LastRow
                For J = 1 To 7
                    .Cells(NewRow, J) = Cells(I, J)
                Next J
                .Cells(NewRow, 8) = Environ("UserName")
                NewRow = NewRow + 1
            Next I
            End With
        '------------------------------------------
        'SAVE, AND CLOSE GLOBAL WORKBOOK
            Worksheets("Flat File").CommandButton1.Enabled = True
            Worksheets("Flat File").CommandButton1.Caption = "Transfer Data"
            Workbooks("Global Journal.xlsx").Close SaveChanges:=True
            MsgBox "Global Journal updated"
            Range("A2:G" & LastRow).ClearContents
            Workbooks("Flat File.xlsm").Close SaveChanges:=True
        End If
    End Sub
    
    
    
    Function FileAlreadyOpen(FullFileName As String) As Boolean
    'http://www.exceltip.com/files-workbook-and-worksheets-in-vba/determine-if-a-file-is-in-use-using-vba-in-microsoft-excel.html
    Dim f As Integer
        f = FreeFile
        On Error Resume Next
        Open FullFileName For Binary Access Read Write Lock Read Write As #f
        Close #f
        If Err.Number <> 0 Then
            FileAlreadyOpen = True
            Err.Clear
        Else
            FileAlreadyOpen = False
        End If
        On Error GoTo 0
    End Function

  10. #8
    New Lounger
    Join Date
    Aug 2014
    Posts
    6
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Retired Geek and Maudibe, Thank you so much...solution with modifications worked wonderfully. I will try and update further. If i need additional help i will reach out to you all.

  11. #9
    New Lounger
    Join Date
    Aug 2014
    Posts
    6
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Maudibe,

    Working from the original code, i need to ammend something. you have me clicking a button in the "flat file" sheet. I actually need to have the button work in a different sheet. Lets call that "accrual file" sheet. I have tried several things but none work.

  12. #10
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,284
    Thanks
    46
    Thanked 255 Times in 235 Posts
    Reitz,

    You did not specify the nature of you problem but here are several things we need to do:

    1. Make sure you are not placing a form control button instead of an active x control. With accrual file sheet selected:

    on the 2010 developer tab, click on the Insert button on the ribbon and select an active x button from the lower half of the grid of icons.

    in 2003 Excel, click on View> toolbars> place a check next to control toolbar to expose the toolbar. Select a command Button from the toolbar and place on accrual file sheet.

    2. Within the VB editor (alt-F11) on the left side of the screen, expand Microsoft Excel Objects if not yet expanded and then double click Sheet#(accrual file) to open the module sheet for that work sheet. Place the code for the button listed at the end below

    3. Changes must be made within the code to accommodate running it from the accrual file sheet.

    In a standard module:
    Code:
    Public Sub TransferData()
    '----------------------------------------------
    'DECLARE AND SET VARIABLES
    Dim FilePath As String
    Dim I As Integer, J As Integer
    FilePath = "E:\Global Journal.xlsx"
    '----------------------------------------------
    'CHECK IF GLOBAL JOURNAL OPEN
        '------------------------------------------
        'OPEN- SCHEDULE RECHECK
        If FileAlreadyOpen(FilePath) = True Then
            Application.OnTime Now + TimeValue("00:01:00"), "TransferData"
            Worksheets("accrual file").CommandButton1.Enabled = False
            Worksheets("accrual file").CommandButton1.Caption = "Saving... Please wait"
        '------------------------------------------
        'CLOSED- OPEN GLOBAL WORKBOOK AND COPY DATA
        Else:
            Workbooks.Open (FilePath)
            With Workbooks("Global Journal.xlsx").Worksheets("Entry")
            NewRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            Workbooks("Flat File.xlsm").Activate
            LastRow = Worksheets("Flat File").Cells(Rows.Count, 1).End(xlUp).Row
            For I = 2 To LastRow
                For J = 1 To 7
                    .Cells(NewRow, J) = Worksheets("Flat File").Cells(I, J)
                Next J
                .Cells(NewRow, 8) = Environ("UserName")
                NewRow = NewRow + 1
            Next I
            End With
        '------------------------------------------
        'SAVE, AND CLOSE GLOBAL WORKBOOK
            Worksheets("accrual file").CommandButton1.Enabled = True
            Worksheets("accrual file").CommandButton1.Caption = "Transfer Data"
            Workbooks("Global Journal.xlsx").Close SaveChanges:=True
            MsgBox "Global Journal updated"
            Worksheets("Flat File").Range("A2:G" & LastRow).ClearContents
            Workbooks("Flat File.xlsm").Close SaveChanges:=True
        End If
    End Sub
    
    
    Function FileAlreadyOpen(FullFileName As String) As Boolean
    'http://www.exceltip.com/files-workbook-and-worksheets-in-vba/determine-if-a-file-is-in-use-using-vba-in-microsoft-excel.html
    Dim f As Integer
        f = FreeFile
        On Error Resume Next
        Open FullFileName For Binary Access Read Write Lock Read Write As #f
        Close #f
        If Err.Number <> 0 Then
            FileAlreadyOpen = True
            Err.Clear
        Else
            FileAlreadyOpen = False
        End If
        On Error GoTo 0
    End Function
    In the accrual file sheet module:
    Code:
    Private Sub CommandButton1_Click()
         TransferData
    End Sub
    Since you did not specify, this code lets you initiate the code from a button on the accrual file sheet but assumes that the source data is still on the Flat File sheet. If the source data is not on the Flat File sheet and is on the accrual file sheet instead, there are a couple of minor changes that still need to be made.

    Maud
    Last edited by Maudibe; 2014-09-01 at 19:22.

  13. The Following User Says Thank You to Maudibe For This Useful Post:

    reitz1 (2014-09-02)

  14. #11
    New Lounger
    Join Date
    Aug 2014
    Posts
    6
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Maudibe,

    This worked...in my trials I had the wrong spreadsheet name and missed one activation of the worksheet.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •