How to pull data from a closed excel workbook and log into active workbook

[sdhutty]

Hello,

Before reading this bear in mind I'm an vba rookie!

I currently have an excel workbook called 'MasterRegister', within this workbook is a sheet called 'Register'.

I have another excel workbook called 'RO Status Log - Practice Copy', within this workbook is a sheet called 'R&O Closed'. This sheet is regularly updated with information in the format below: (NOTE: When it updates it adds a row to the top not the bottom)

Column A Column B Column C Column D Column E
[TABLE="width: 400"]
<tbody>[TR]
[TD]R&O Number[/TD]
[TD]Document Number[/TD]
[TD]Document Type[/TD]
[TD]Unit Affected[/TD]
[TD]Issue/Revision[/TD]
[/TR]
[TR]
[TD]15610[/TD]
[TD]J466[/TD]
[TD]REPORT[/TD]
[TD]ENGINE[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]17483[/TD]
[TD]JRRU[/TD]
[TD]LETTER[/TD]
[TD]F18[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]78172[/TD]
[TD]HGU7[/TD]
[TD]SERVICE[/TD]
[TD]2891[/TD]
[TD]10[/TD]
[/TR]
</tbody>[/TABLE]

As this is updated with new data, I want the excel workbook 'MasterRegister' to also record this same new data in its worksheet "Register" WITHOUT needing to open the 'RO Status Log' workbook.

I want it to record the information in the columns stated below:

R&O Number: Column A
Document Number: Column B
Document Type: Column B
Unit Affected: Column L
Issue/Revision: Column G

So in procedure: I will open the 'MasterRegister' workbook & from a command button on the 'Register' sheet - it will show a message box stating:

"5 new entries have been made in RO Status Log - Entries now recorded in the sheet". If there isn't any new entries it will say "No new entries".

I have attempted to do this - but by pressing the command button it opens the RO Status log workbook which I obviously do not want and attempts to copy the whole column which I do not want also.

Sub AutoCopyVersion()
Dim pasteTo As Range
Dim countRows, i As Long
countRows = Application.CountA(Range("A:A"))
Workbooks.Open Filename:="C:\Users\SAN1011\Documents\RO Status Log - Practice Copy.xlsm"
i = Application.CountA(ActiveWorkbook.Sheets("R&O Closed").Range("A:A"))
If i = countRows Then Exit Sub
ActiveWorkbook.Sheets("R&O Closed").Range("A" & countRows + 1 & ":C" & i).Select
Selection.Copy
Workbooks("RO Status Log - Practice Copy.xlsm").Close
Set pasteTo = Sheets("Register").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ThisWorkbook.ActiveSheet.Paste Destination:=pasteTo
Application.CutCopyMode = False
End Sub

 

[baitmaster]

please confirm my understanding - where is this code going to be placed? I assume you are aiming to manually open the master workbook and run this code from there to pull data in?

 

[sdhutty]

Thanks for getting back to me.

Yes I'm aiming to place the code in the MasterRegister workbook.

The 'RO Status Log' workbook will be closed & I will manually open the MasterRegister workbook and run the code from there - command button if possible.

 

[baitmaster]

I've had a bit of a tweak but it's untested. Where there's no new data you're exiting the sub before closing the file you've just opened. I've split the address element out as a separate string, I don't think it looks right and you'll be able to test it later if it's wrong, to understand why - debug.print writes the text to the immediate window each time you run the code. View > Immediate window will show you the value

As you have the address string you don't need to try and create a pasteTo object

by using pastespecial instead of paste we don't need the worksheet active

Sub AutoCopyVersion()
Dim countRows As Long, i As Long, strAddress As String

countRows = Application.CountA(Range("A:A"))
Workbooks.Open Filename:="C:\Users\SAN1011\Documents\RO Status Log - Practice Copy.xlsm"
i = Application.CountA(ActiveWorkbook.Sheets("R&O Closed").Range("A:A"))
If i = countRows Then GoTo endRoutine

strAddress = "A" & countRows + 1 & ":C" & i ' this looks wrong
debug.print strAddress

ActiveWorkbook.Sheets("R&O Closed").Range(strAddress).Copy
ThisWorkbook.Sheets("Register").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False

endRoutine:
Workbooks("RO Status Log - Practice Copy.xlsm").Close savechanges:=False
End Sub

 

[sdhutty]

Hello,

It works and it doesn't work!

It works in the sense it copies the data without needing to open the workbook.

It doesn't work in the sense that when it copies the data, it copies columns A-C, whereby I need it to copy the latest row of data, not the columns. (Because new info is updated in reverse order - row 4 is where the latest updated information is inserted. - However on particular days it can range from just 1 row of date that's new, to 4 rows of new data) - so the macro needs to copy the new rows after each update.

Also if its possible to make a message box appear when you click the command button stating for example "5 new updates available - proceed, yes or no?"

Thanks for the help!

 

[baitmaster]

OK cool

FYI it does open the workbook, but it also closes it again. A warning here, it doesn't save any changes when closing it, so if it's already open and unsaved, you'll lose any changes you made. You could add some extra tests to see if it was open and either close / not close, but these are unnecessary if it always will be closed

As I suspected, the range declared is wrong, and this would be visible if you look at the Immediate window after running the code. Try the following

Option Explicit
Sub AutoCopyVersion()
Dim countRowsThis As Long, countRowsSource As Long, iNewRecords As Integer, strAddress As String, strReport As String, intBtnType As Integer, proceed As Integer

' count rows in this file
countRowsThis = Application.CountA(Range("A:A"))

' open source file, which becomes active file
Workbooks.Open Filename:="C:\Users\SAN1011\Documents\RO Status Log - Practice Copy.xlsm"

' count rows in that source file
countRowsSource = Application.CountA(ActiveWorkbook.Sheets("R&O Closed").Range("A:A"))

' calculate new entries
iNewRecords = countRowsSource - countRowsThis

' decide what to do based on delta
Select Case iNewRecords
    Case Is < 0
        strReport = "ERROR: there are less entries in source file than in this file"
        intBtnType = vbCritical
        
    Case 0
        strReport = "no entries found in source file"
        intBtnType = vbInformation
        
    Case Else
        
        ' create address for copying
       [COLOR=#FF0000] strAddress = "A" & 1 & ":C" & iNewRecords[/COLOR]
        
        ' ask if import required
        proceed = MsgBox(iNewRecords & " new records found at range " & strAddress & ". Do you wish to import?", vbQuestion + vbYesNo)
        If proceed = vbYes Then
        
            ' copy / paste
            ActiveWorkbook.Sheets("R&O Closed").Range(strAddress).Copy
            ThisWorkbook.Sheets("Register").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
            Application.CutCopyMode = False
            
            strReport = iNewRecords & " new entries found. Copied from range " & strAddress
            intBtnType = vbInformation
        Else
            ' no action required
        End If
        
End Select
' report results and close file

endRoutine:
Workbooks("RO Status Log - Practice Copy.xlsm").Close savechanges:=False
If strReport <> "" Then MsgBox strReport, intBtnType
End Sub

EDIT: you need to adjust the range to account for header rows, to e.g.

strAddress = "A" & 2 & ":C" & iNewRecords + 1

 

[sdhutty]

Hi Baitmaster,

Sorry for the delayed reply.

I have tested your code, it works however there are a few issues:

1) I am unsure what the phrase "ERROR: there are less entries in source file than in this file" is describing, please could you explain.

2) When the data copies into the spreadsheet it also copies the formatting - such as borders. How do we remove this so it just copies the values?

3) When it copies the data It copies into columns A-E. It doesn't copy into the necessary columns I would like it to copy into as stated before.

4) When it states "new records found" it counts according to number of rows. So I changed the range to "A4,B4,C4,D4" - thus it says '4 new entries found', whereby I would like it to say 'one entry found' so as if its reading from column A - 'R&O Number'. So if another row is created it will read from this row in column A, not all column rows & thus say "1 new R&O Number entry found, Do you wish to import?".

5) Also I had to change the range to A4-D4, so this doesn't include new data that would be updated - it will only copy those rows. Is there a way to copy the new data according to when the R0 Status Log spreadsheet was last updated?


Again thanks for the help!

 

[baitmaster]

1) I like completeness, it prevents problems later in your code when something unexpected happens. If there is something wrong with the source data e.g. something got deleted, then I think you need to receive a warning, so when you have more data in this file than the data source you'll hear about it and can investigate. Good coding is not just about doing what you want, but also covering off the stuff you don't want

2) We're using PasteSpecial for the import, so we can replace xlPasteAll with xlPasteValues and get only the data values with no formatting

3) sorry I missed the bit about specific columns. You could simply look at each column at a time:

' copy / paste
With ActiveWorkbook.Sheets("R&O Closed").Range(strAddress)
    .Columns(1).Copy
    ThisWorkbook.Sheets("Register").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    .Columns(2).Copy
    ThisWorkbook.Sheets("Register").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    .Columns(3).Copy
    ThisWorkbook.Sheets("Register").Range("xxxx" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    .Columns(4).Copy
    ThisWorkbook.Sheets("Register").Range("L" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    .Columns(5).Copy
    ThisWorkbook.Sheets("Register").Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
End WithApplication.CutCopyMode = False

NOTE: I've marked a column as xxxx as you've suggested column B twice

4) I'm not sure I understand. But if' you've changed the code so that it counts everything 4 times, then you could /4, i.e. iNewRecords = iNewRecords/4

5) a bit confused with this one too. You can look at the source file documentProperties to see when it was last saved. Or you could apply a time/date marker to individual lines of data in that file, using a worksheet_change event to apply a time stamp

 

[sdhutty]

Thanks for the columns & past special advice that works great!

What I meant regarding the other 2 points:

Point 4:

I added the '/4' & It works illustrating that "one new entry found" - However is it possible to also say the value of the new entry? So it will also say the R&O Number in column A as well. For example it will state: "One new entry found - R&O Number: 15678". It is therefore reading from column A in the 'RO Status Log'.

Point 5:

Basically the data that is being imported isn't being imported by the last updated on the 'RO Status Log Sheet'.

Although it imports the data - it doesn't register when this data was created in the R0 Status Log. I want it to import the data when there are new entries in the RO Status Log, as a sense when the R0 Status Log was last saved or last updated.

It also only copies row 4 constantly. So for example If the R0 Status Log has 4 new entries - the vba code only registers row 4 and will not register the other 3 rows (5,6,7) of new data that has been added. This then comes into play whereby the code says:

' count rows in this file
countRowsThis = Application.CountA(Range("A4,B4,C4,D4"))' open source file, which becomes active file
Workbooks.Open Filename:="C:\Users\SAN1011\Documents\RO Status Log - Practice Copy.xlsm"
' count rows in that source file
countRowsSource = Application.CountA(ActiveWorkbook.Sheets("R&O Closed").Range("A4,B4,C4,D4"))

Regardless of new updates in the R0 Status Log - it will only copy these rows of data. So this has to be changed in accordance to copying the latest data from when it was last saved or last updated in RO Status Log.

Any clearer? Lol

Thanks

 

[baitmaster]

I think you're getting confused on what you're trying to do, or I'm missing something. I can't see why you're now counting 4 specific cells A4:D4, as this should always return the value 4. But that value is assigned to "row count". The purpose of the calculation should be to work out how may rows are in the source and compare with how many are in the destination, to identify the range of cells that needs to be extracted

So what I'm doing is creating a range object [Range(strAddress)] that will be extracted a column at a time. It should be column A to column E as per your original requirement, row 2 (assuming row 1 is header) to row [number of new records] +1 header. I can then loop through each column and pull the data out

If you want to put individual time stamps against each row of data you'll need to do this when the data is created, but that has it's own set of issues as it relies on system clocks being accurate and consistent across all machines. You might instead consider sticking an "imported" marker against each row when it is processed, or simply import any data that does not already exist in your central data. Which then begs the question, why are you actually doing this? Is there a better way to work with all of your data in one location from the start, rather than have it in one file, then pass it to another file etc.? I'm not going to start trying to manage time stamps etc., that's a whole new question for the board, but you might be better - if you can progress your VBA skills quickly - to consider using a single database that is accessed when necessary, where each row is always there but you stick a status marker against it. An example Access database + Excel front end with VBA controls is available as a free download at Case studies & example files - Spreadsheet Wizard Ltd, see the last example file on the page

Updated code that I think you want, without some of the changes you made above:

Sub AutoCopyVersion()
Dim countRowsThis As Long, countRowsSource As Long, iNewRecords As Integer, strAddress As String, strReport As String, intBtnType As Integer, proceed As Integer
[COLOR=#FF0000]Dim arrResults(), i As Integer, cl As Range[/COLOR]
' count rows in this file
countRowsThis = Application.CountA(Range("A:A"))

' open source file, which becomes active file
Workbooks.Open Filename:="C:\Users\SAN1011\Documents\RO Status Log - Practice Copy.xlsm"

' count rows in that source file
countRowsSource = Application.CountA(ActiveWorkbook.Sheets("R&O Closed").Range("A:A"))

' calculate new entries
iNewRecords = countRowsSource - countRowsThis

' decide what to do based on delta
Select Case iNewRecords
    Case Is < 0
        strReport = "ERROR: there are less entries in source file than in this file"
        intBtnType = vbCritical
        
    Case 0
        strReport = "no entries found in source file"
        intBtnType = vbInformation
        
    Case Else
        
        ' create address for copying
        [COLOR=#FF0000]strAddress = "A" & 2 & ":E" & iNewRecords + 1 ' allows +1 for header row[/COLOR]
        
        [COLOR=#FF0000]' resize array to hold references
        ReDim arrResults(1 To iNewRecords)
        For Each cl In Range(strAddress).Columns(1)
            i = i + 1
            [COLOR=#ff0000]arrResults[/COLOR](i) = cl.Value
        Next cl[/COLOR]
        
        ' ask if import required
        proceed = MsgBox(iNewRecords & " new records found at range " & strAddress & ". Do you wish to import?" [COLOR=#FF0000]& vbCr & Join(arrResults, "; ")[/COLOR], vbQuestion + vbYesNo)
        If proceed = vbYes Then
        
            ' copy / paste
            With ActiveWorkbook.Sheets("R&O Closed").Range(strAddress)
                .Columns(1).Copy
                ThisWorkbook.Sheets("Register").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
                .Columns(2).Copy
                ThisWorkbook.Sheets("Register").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
                .Columns(3).Copy
                ThisWorkbook.Sheets("Register").Range("[B][COLOR=#FF0000]xxxx[/COLOR][/B]" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
                .Columns(4).Copy
                ThisWorkbook.Sheets("Register").Range("L" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
                .Columns(5).Copy
                ThisWorkbook.Sheets("Register").Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
            End With
            
            Application.CutCopyMode = False
            
            strReport = iNewRecords & " new entries found. Copied from range " & strAddress
            intBtnType = vbInformation
        Else
            ' no action required
        End If
        
End Select
' report results and close file
endRoutine:
Workbooks("RO Status Log - Practice Copy.xlsm").Close savechanges:=False
If strReport <> "" Then MsgBox strReport, intBtnType
End Sub

As ever, this code is untested. Before you make any further changes (e.g. counta(Range("A4,B4,C4,D4")) ), make sure you understand what the code is trying to do and why / how