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

R&O Number	Document Number	Document Type	Unit Affected	Issue/Revision
15610	J466	REPORT	ENGINE	1
17483	JRRU	LETTER	F18	8
78172	HGU7	SERVICE	2891	10

<tbody>
</tbody>

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

 

[sdhutty]

Ah is see where you're getting confused.

There is data after the headers.

The register worksheet rows 1-4 are merged & centred with text and row 5 is the headers where the filters are and then there is data that begins on row 6 with the next blank row on 1258.

The jumping up to the next cell - for the R0 Status Log this will 'jump' to the wrong data row - it wont jump to the latest data at the top of the worksheet. R0 Status Log the header is on row 3 and new data begins on row 4 as stated previously.

This new way of coding seems very different to the one we previously had. Can we not amend the previous coding & just amend the coding to adjust to data already in column A? It seemed to work when no data was in column A of register worksheet, but as soon as I put data into the rows of column A to be on par with the last row of the other columns then it didn't work.

 

[baitmaster]

I need to see it for myself. I've spent long enough trying to guess at the layout, hence why I requested you provide a copy of the file a couple of days ago. Send me the files and I'll get them working

 

[sdhutty]

Ok I've mended the code I last posted as such:

Sub AutoCopyVersion()
Dim countRowsThis As Long, countRowsSource As Long, iNewRecords As Integer, strAddress As String, strReport As String, intBtnType As Integer, proceed As Integer
Dim arrResults(), i As Integer, cl As Range

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

' open source file, which becomes active file
Application.ScreenUpdating = False
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 - 2

' 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. Row(s) have been deleted from the source file. Please amend."
        intBtnType = vbCritical
        
    Case 0
        strReport = "No new entries found."
        intBtnType = vbInformation
        
    Case Else
        
        ' create address for copying
        strAddress = "A" & 4 & ":E" & iNewRecords + 3 ' allows +1 for header row
        
        ' resize array to hold references
        ReDim arrResults(1 To iNewRecords)
        For Each cl In Range(strAddress).Columns(1).Cells
            i = i + 1
            arrResults(i) = cl.Value
        Next cl
        
        ' ask if import required
        Debug.Print Join(arrResults, ", ")
        proceed = MsgBox(iNewRecords & " new records found. R&O Numbers: " & Join(arrResults, ", ") & ". Do you wish to import?", 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 xlPasteValues
                .Columns(2).Copy
                ThisWorkbook.Sheets("Register").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                .Columns(3).Copy
                ThisWorkbook.Sheets("Register").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                .Columns(4).Copy
                ThisWorkbook.Sheets("Register").Range("L" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                .Columns(5).Copy
                ThisWorkbook.Sheets("Register").Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            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

I've done the range of:

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

As such because A1258 is when the next blank row begins and I've done A1048576 because its the very end of the spreadsheet as you said. I'm assuming when it gets to that number row that I will have to go back into the code and increase the number, yes?

Also I've kept the R&O Closed range as ("A:A") - so it picks up every number right?

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

Now it works although it says when its found new entries:

"10 new records found. R&O Numbers:, R&O Folder Link, unknown, unkown......unknown."

Not sure why its still says R&O Folder Link as I've put the range from A1258.

& unknown I am not sure.

 

[sdhutty]

Its technical data so im afraid I cannot. No worries, thanks for your help, I shall let you know if I solve it!