Combining Information - VBA Code

John_Gil

New Member
Joined
Jun 3, 2020
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
Hello Excel masters! :)

I need to develop a VBA code that brings information from a different file (3 different tabs) and combines everything into one final file.

The final file looks like the table below. We have 7 columns (column 3, 4 and 7 have always the same value):

The file from where the information is coming has the previous view:

Steps of the macro:
1- Filter in tabs "NI" and "ROI" column R by "C" and copy the information from columns C, D, I and P;
2- Filter in tab "OCADO" column Q by "C" and copy the information from columns C, D, I and o;
3- Paste information on the final file according with by column order shown in the final file.


I would really appreciate your help guys! :)

Thank you,
John
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,512
Office Version
  1. 2013
Platform
  1. Windows
I only did limited testing on this.

VBA Code:
Sub t()
Dim sh As Worksheet, ary As Variant, i As Long
Set sh = Workbooks("CustomerAmendments").Sheets(1) 'Edit destination sheet name
ary = Array("NI", "ROI", "OCADO")
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
            .UsedRange.AutoFilter 18, "C"
            .Range("C2", .Cells(Rows.Count, 3).End(xlUp)).Copy sh.Cells(Rows.Count, 5).End(xlUp)(2)
            .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            .Range("I2", .Cells(Rows.Count, 9).End(xlUp)).Copy sh.Cells(Rows.Count, 6).End(xlUp)(2)
                If i <> UBound(ary) Then
                    .Range("P2", .Cells(Rows.Count, 16).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                Else
                    .Range("O2", .Cells(Rows.Count, 15).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                End If
            .AutoFilterMode = False
        End With
    Next
End Sub
 

John_Gil

New Member
Joined
Jun 3, 2020
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
Hi @JLGWhiz and thank you so much for your help!

I get a error on the code on the seting part (please see below I highlighted in yellow):

VBA Code:
Sub CustomerAmends()
Dim sh As Worksheet, ary As Variant, i As Long
[COLOR=rgb(247, 218, 100)]Set sh = Workbooks("X:\Planning\production plans\production plans\Order Amendments\Combined amendments.xlsm").Sheets(1)[/COLOR] 

ary = Array("NI", "ROI", "OCADO")
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
            .UsedRange.AutoFilter 17, "C"
            .Range("C2", .Cells(Rows.Count, 3).End(xlUp)).Copy sh.Cells(Rows.Count, 5).End(xlUp)(2)
            .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            .Range("I2", .Cells(Rows.Count, 9).End(xlUp)).Copy sh.Cells(Rows.Count, 6).End(xlUp)(2)
                If i <> UBound(ary) Then
                    .Range("P2", .Cells(Rows.Count, 16).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                Else
                    .Range("O2", .Cells(Rows.Count, 15).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                End If
            .AutoFilterMode = False
        End With
    Next
End Sub

Also on the tabs NI and ROI the filter should be on column 18 and on tab OCADO should be on column 17. Could you please make this adjustment as well?

Thank you,
John
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,784
Office Version
  1. 365
Platform
  1. Windows
please see below I highlighted in yellow)
To manually highlight code you must use the rich tags, not vba tags
1597147010017.png
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,512
Office Version
  1. 2013
Platform
  1. Windows
This should fix the AutoFilter part.
VBA Code:
Sub t()
Dim sh As Worksheet, ary As Variant, i As Long
Set sh = Workbooks("CustomerAmendments").Sheets(1) 'Edit destination sheet name
ary = Array("NI", "ROI", "OCADO")
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
            If i <> UBound(ary) Then
                .UsedRange.AutoFilter 18, "C"
            Else
                .UsedRange.AutoFilter 17, "C"
            End If
            .Range("C2", .Cells(Rows.Count, 3).End(xlUp)).Copy sh.Cells(Rows.Count, 5).End(xlUp)(2)
            .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            .Range("I2", .Cells(Rows.Count, 9).End(xlUp)).Copy sh.Cells(Rows.Count, 6).End(xlUp)(2)
                If i <> UBound(ary) Then
                    .Range("P2", .Cells(Rows.Count, 16).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                Else
                    .Range("O2", .Cells(Rows.Count, 15).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                End If
            .AutoFilterMode = False
        End With
    Next
End Sub
For the 'Set sh' satement, if the workbook is not already open you would get a 'Subscript out of range' error, so you need to either manually open the workbook before running the code or add modify the code with
VBA Code:
Dim wb As Workbook
Set wb = Workbooks.Open("X:\Planning\production plans\production plans\Order Amendments\Combined amendments.xlsm")
Set sh = wb.Sheets(1)
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,512
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Clarification: If the workbook is already open then you only need:

VBA Code:
Set sh = Workbooks("Combined amendments.xlsm").Sheets(1)

If it is not open at run time, then you would need to use the Workbooks.Open method using the full path name.
 

John_Gil

New Member
Joined
Jun 3, 2020
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
Looks much better now and no error is displayed but it is still not working. Could it be because on the origin file I have more than only the 3 tabs ("ROI" "NI" and "OCADO")? In the file there are all the tabs in the picture below.
1597157108480.png


Could this be the issue?
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,512
Office Version
  1. 2013
Platform
  1. Windows
You need to give a better description of the results than "Not working". What is it doing? Is it producing any results and, if so, what are they?
The sheets are called up from an array, so it makes no difference how many you have in the workbook. If you have altered the code I posted, please copy and paste it back to the thread reply window so I can see what you are working with. Don't forget to use the code tags to retain fromatting.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,512
Office Version
  1. 2013
Platform
  1. Windows
Also, the code needs to be in code module1 or one of the other user inserted code modules, not a sheet, userform or ThisWorkbook module. It is also unclear which workbook you are running the code from.
 

Watch MrExcel Video

Forum statistics

Threads
1,112,817
Messages
5,542,670
Members
410,567
Latest member
SCraig123
Top