Using VBA to update workbook B extracting data from workbook A

[Rafaa]

Hi,


In order to do the tests, I'm using 2 simplified workbooks (test_copy and test_paste).

What I'd like to be able to do, once I click a button UPLOAD (creating the button isn't the problem), is to go to the first cell from workbook test_copy, check if that code is already on test_paste and if not add it to the bottom of the list, repeating the same cycle for each code on the workbook test_copy.

The orders of the codes might change on both workbooks differently depending on the way the columns are sorted. That is why I believe that for each code in test_copy I need to check the entire column in test_paste to check if the code already exists.

At the end of the routine, on the example below, we would have the codes 2670, 2676 and 2626 added to the end of the list on test_paste.

test_copy

Excel 2012

	A

<colgroup><col style="width: 25pxpx"><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]
[TD="align: center"]2684[/TD]

[TD="align: center"]2[/TD]
[TD="align: center"]2783[/TD]

[TD="align: center"]3[/TD]
[TD="align: center"]2669[/TD]

[TD="align: center"]4[/TD]
[TD="align: center"]2670[/TD]

[TD="align: center"]5[/TD]
[TD="align: center"]2676[/TD]

[TD="align: center"]6[/TD]
[TD="align: center"]2681[/TD]

[TD="align: center"]7[/TD]
[TD="align: center"]2601[/TD]

[TD="align: center"]8[/TD]
[TD="align: center"]2626[/TD]

</tbody>

Sheet1​

test_paste

Excel 2012

	A

<colgroup><col style="width: 25pxpx"><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]
[TD="align: center"]2684[/TD]

[TD="align: center"]2[/TD]
[TD="align: center"]2783[/TD]

[TD="align: center"]3[/TD]
[TD="align: center"]2669[/TD]

[TD="align: center"]4[/TD]
[TD="align: center"]2681[/TD]

[TD="align: center"]5[/TD]
[TD="align: center"]2601[/TD]

</tbody>

Sheet1​

Thank you very much in advance for your assistance.


Kind regards,


Rafael

 

[hiker95]

Rafaa,

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


Sample worksheets:

Excel 2007
	A
1	2684
2	2783
3	2669
4	2670
5	2676
6	2681
7	2601
8	2626
9
test_copy

Excel 2007
	A
1	2670
2	2676
3
4
5
6
7
8
9
test_paste

After the macro in worksheet test_paste:

Excel 2007
	A
1	2670
2	2676
3	2684
4	2783
5	2669
6	2681
7	2601
8	2626
9
test_paste

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub CopyNotFound()
' hiker95, 03/28/2014, ME67403
Dim wc As Worksheet, wp As Worksheet
Dim c As Range, frng As Range, nr As Long
Application.ScreenUpdating = False
Set wc = Sheets("test_copy")
Set wp = Sheets("test_paste")
With wc
  For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    Set frng = wp.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If frng Is Nothing Then
      nr = wp.Cells(wp.Rows.Count, "A").End(xlUp).Row + 1
      If nr = 2 And wp.Cells(1, 1) = "" Then nr = 1
      wp.Cells(nr, 1).Value = c.Value
    End If
  Next c
End With
With wp
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CopyNotFound macro.



In the above macro code, you can change the following two lines of code (the BOLD text) to reflect the actual worksheet names:

Set wc = Sheets("test_copy")
Set wp = Sheets("test_paste")

 

[Rafaa]

Hi hiker95,


Thank you very much for your reply. I'm using excel 2013 for Windows, but the spreadsheets will also be used by mac users.

I've noticed that your code refer to worksheets in the same workbook, but I'll have to work on different workbooks. I tried to modified the code you provided as follows, but it didn't work. I'm still trying to make it work but I'm new with VBA, which might explain why I haven't had success yet! =D

For the tests, I'm opening the workbooks manually, but on the original code I will have the sections of the code to treat the opening of the files, you don't have to worry about that, thank you.

After the change I made, the issue is happening on line 9: Object doesn't support this property or method. (Line 9)



Sub CopyNotFound()
' hiker95, 03/28/2014, ME67403


Dim wc As Workbook, wp As Workbook
Dim c As Range, frng As Range, nr As Long


Application.ScreenUpdating = False


Set wc = Workbooks("test_copy.xlsx")
Set wp = Workbooks("test_paste.xlsx")


With wc
For Each c In .Sheets("Sheet1").Range("A1", .Range("A" & Rows.Count).End(xlUp))
Set frng = wp.Sheets("Sheet1").Columns(1).Find(c.Value, LookAt:=xlWhole)
If frng Is Nothing Then
nr = wp.Sheets("Sheet1").Cells(wp.Rows.Count, "A").End(xlUp).Row + 1
If nr = 2 And wp.Sheets("Sheet1").Cells(1, 1) = "" Then nr = 1
wp.Sheets("Sheets1").Cells(nr, 1).Value = c.Value
End If
Next c
End With
With wp
.Sheets("Sheet1").Columns(1).AutoFit
.Sheets("Sheet1").Activate
End With
Application.ScreenUpdating = True
End Sub


I appreciate your assistance.

 

[Rafaa]

Hi hiker95,

I set objects for the workbooks first and it worked.

Set wbx = Workbooks("test_copy.xlsx")
Set kh = Workbooks("test_paste.xlsm")

Set wc = wbx.Sheets("Sheet1")
Set wp = kh.Sheets("Sheet1")

Thank you very much for your help!

How could I extrapolate your code to copy not only the column A, but also other columns of that specific row?

On your test the first number copied was 2684, for example, and let's say that it would be interesting to also copy the column B and D of that row, that contains important information to be pasted on the workbook test_paste.

Ex.
test_copy
A B C D
[TABLE="width: 354"]
<tbody>[TR]
[TD="class: xl63, width: 64"]2684 [/TD]
[TD="class: xl63, width: 103"]Green bananas [/TD]
[TD="class: xl63, width: 100"] Supplier A[/TD]
[TD="class: xl63, width: 87"]30 units [/TD]
[/TR]
</tbody>[/TABLE]

test_paste
A B C D
[TABLE="width: 354"]
<tbody>[TR]
[TD="class: xl63, width: 64"]2684 [/TD]
[TD="class: xl63, width: 103"]Green bananas [/TD]
[TD="class: xl63, width: 100"] [/TD]
[TD="class: xl63, width: 87"]30 units
[/TD]
[/TR]
</tbody>[/TABLE]

I believe that the change needs to happen on this row:

wp.Cells(nr, 2).Value = c.Value

But I don't know the syntax that represents: wp.Range(nr, columns B & D).Value = c.(columns B & D).Value


Is that the way to go?


Thanks once again.

 

[Rafaa]

I thought of doing the following, but it doesn't seem to be the most refined idea. =D Let's say I want to copy a lot of different columns, I would repeat the code line for each column desired.

wp.Cells(nr, 2).Value = c.Value
wp.Cells(nr, 3).Value = c.Value
wp.Cells(nr, 4).Value = c.Value

But I still don't know how to replace c.Value.

 

[hiker95]

Rafaa,

I have no experience with a Mac.

But I still don't know how to replace c.Value.

In order to assist you please post your complete macro code using code tags.


When posting VBA code, please use Code Tags - like this:

[code=rich]

'Paste your code here.

[/code]

 

[Rafaa]

Hi hiker95,


The code below is working perfectly since you've presented a solution for my original question, thank you. The question now is how can I carry other columns (multiple cells) at the same time when copying and pasting the data?

So, as we are copying the code 2684, I also need to be able to copy the description of that code that is on column B, for example, and the quantities of that item that is on column D. I hope it is clear what I'm trying to explain, please let me know if you have any questions.

Thanks once again for your help.

Sub Extract()
     
    Dim wbx As Workbook
    Dim kh As Workbook
    Dim wc As Worksheet, wp As Worksheet
    Dim c As Range, frng As Range, nr As Long
        
    Application.ScreenUpdating = False
        
        
    'Open worksheet X
    If IsWBOpen("X_Orders Worksheet_v3.3_draft.xlsx") = False Then
         Workbooks.Open Filename:="X_Orders Worksheet_v3.3_draft.xlsx", Password:="********"
    End If
      
    Set wbx = Workbooks("X_Orders Worksheet_v3.3_draft.xlsx")
    Set kh = Workbooks("TEST.xlsm")
    
    Set wc = wbx.Sheets("Orders")
    Set wp = kh.Sheets("Orders")
    
    With wc
        For Each c In .Range("B8", .Range("B" & Rows.Count).End(xlUp))
            Set frng = wp.Columns(2).Find(c.Value, LookAt:=xlWhole)
            If frng Is Nothing Then
                nr = wp.Cells(wp.Rows.Count, "B").End(xlUp).Row + 1
                If nr = 9 And wp.Cells(8, 2) = "" Then nr = 8
                wp.Cells(nr, 2).Value = c.Value
            End If
        Next c
    End With
    
    With wp
        '.Columns(1).AutoFit
        .Activate
    End With


    wbx.Close SaveChanges:=False
        
    Application.ScreenUpdating = True
    


End Sub




Private Function IsWBOpen(wbname As String) As Boolean
  'Return TRUE if workbook is open


  Dim wb As Workbook


  On Error Resume Next
  Set wb = Workbooks(wbname)
  If Err = 0 Then IsWBOpen = True _
    Else IsWBOpen = False
    


End Function

 

[hiker95]

Rafaa,

By the way - nicely written code.


Your instructions, and, your new text display do not seem to match?

If I understand you correctly:
1. Your key column for the variable c is column B?


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub Extract_V2()
' hiker95, 03/31/2014, ME767403
Dim wbx As Workbook
Dim kh As Workbook
Dim wc As Worksheet, wp As Worksheet
Dim c As Range, frng As Range, nr As Long
Application.ScreenUpdating = False

'Open worksheet X
If IsWBOpen("X_Orders Worksheet_v3.3_draft.xlsx") = False Then
  Workbooks.Open Filename:="X_Orders Worksheet_v3.3_draft.xlsx", Password:="********"
End If

Set wbx = Workbooks("X_Orders Worksheet_v3.3_draft.xlsx")
Set kh = Workbooks("TEST.xlsm")
Set wc = wbx.Sheets("Orders")
Set wp = kh.Sheets("Orders")
With wc
  For Each c In .Range("B8", .Range("B" & Rows.Count).End(xlUp))
    Set frng = wp.Columns(2).Find(c.Value, LookAt:=xlWhole)
    If frng Is Nothing Then
    
      nr = wp.Cells(wp.Rows.Count, "B").End(xlUp).Row + 1
      If nr = 9 And wp.Cells(8, 2) = "" Then nr = 8
      
      wp.Cells(nr, 2).Value = c.Value
      
      wp.Cells(nr, 3).Value = c.Offset(, 1).Value
      wp.Cells(nr, 4).Value = c.Offset(, 2).Value
      wp.Cells(nr, 5).Value = c.Offset(, 3).Value
      
    End If
  Next c
End With
With wp
  '.Columns(1).AutoFit
  .Activate
End With
wbx.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

Private Function IsWBOpen(wbname As String) As Boolean
'Return TRUE if workbook is open
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(wbname)
If Err = 0 Then IsWBOpen = True Else: IsWBOpen = False
End Function

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the Extract_V2 macro.


If the new macro does not work correctly, then, I will need screenshots of before and after, NOT text displays, but, using of the described methods below:

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel.com | Excel Resources | Excel Seminars | Excel Products

You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[Rafaa]

Hi hiker95,


Thank you. But the core of it was written by you! =D

Yes. Sorry, I used a simplified example to tell you what I needed, but the code was written to be tested against other files and you are right, there the key column is B. You've understood my problem though, thank you! I didn't know the trick with the Offset, I believe that it will work. I will let you know if it doesn't. =P

Excellent! I appreciate you assistance, mate! Have a good day!


Regards,

Raf

 

[hiker95]

Rafaa,

Excellent! I appreciate you assistance, mate! Have a good day!

Thanks for the feedback.

You are very welcome.

Waiting to hear about you testing the new code.