Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Match three columns together between two workbooks and copy values next column

0

hello

I  try  matching   three  columns  b,c,d  between  two  workbooks   and  copy  the  values  in  last  column   G  from file  aa    to  the  empty  last  column  in  file  bb   and  if  there  is   brand  is  existed in file a  and   it 's not existed  bb  should  also  copy  to  file  bb  in  my  case  e  and  if  i  repeat  run  the  macro  copy  to  the  next column  f or  g  ... and  so  on   

this  is   my  code 

Sub MATCHCOLUMNS()

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Variant
Application.ScreenUpdating = False
Set w1 = Workbooks("bb.xlsm").Worksheets("sheet1")
Set w2 = Workbooks("aa.xlsx").Worksheets("sheet1")
For Each c In w1.Range("b2:d", w1.Range("d" & Rows.Count).End(xlUp))
    FR = Application.Match(c, w2.Range("b2:d"), 0)
    If IsNumeric(FR) Then c.Offset(, 5).Value = w2.Range("G" & FR).Value
Next c
Application.ScreenUpdating = True
End Sub

thanks  in advance

Answer
Discuss

Answers

0
Selected Answer

Here's the code you have been looking for. I have refrained from commenting the code but added good explanations to the variable declarations. Of course, you will need to change the two constants at the top before the code can run for you, even in the attached workbook. But the file specified in the code is a copy of your sample file "aa".

Sub UpdateInventory()
    ' 185

    ' change to suit: Path must end on backslash
    Const SourcePath As String = "D:\PVT Archive\Class 1\1-2021 (Jan 2023)\"
    Const SourceBook As String = "185 TXL 210303 Inventory Update (aa).xlsx"

    Dim WbS         As Workbook                 ' source book
    Dim WsS         As Worksheet                ' source sheet
    Dim WbT         As Workbook                 ' target book
    Dim WsT         As Worksheet                ' target sheet (in ThisWorkbook)
    Dim Rs          As Long                     ' Row: source
    Dim Rt          As Long                     ' Row: target
    Dim Cl          As Long                     ' last used column in WsS
    Dim Ct          As Long                     ' target column in WsT
    Dim C           As Long                     ' loop counter: column
    Dim Target      As Range                    ' search range in WsT
    Dim Fnd         As Range                    ' result of Find function
    Dim FirstFound  As Long                     ' Target.Row where first match was found
    Dim Arr         As Variant                  ' source data: Rt

    Set WbT = ThisWorkbook
    Set WsT = WbT.Worksheets("Sheet1")
    With WsT
        Set Target = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
        Ct = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1
    End With
    Application.ScreenUpdating = False

    On Error Resume Next
    Set WbS = Workbooks(SourceBook)
    If Err Then Set WbS = Application.Workbooks.Open(SourcePath & SourceBook)

    On Error GoTo 0
    Set WsS = WbS.Worksheets("Sheet1")
    With WsS
        Cl = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For Rs = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
            Arr = .Range(.Cells(Rs, 1), .Cells(Rs, Cl)).Value
            Set Fnd = Target.Find(Arr(1, 2), , xlValues, xlWhole)
            If Not Fnd Is Nothing Then
                FirstFound = Fnd.Row
                Do
                    If Fnd.Offset(0, 1).Value = Arr(1, 3) And _
                       Fnd.Offset(0, 2).Value = Arr(1, 4) Then
                       Fnd.Offset(0, Ct - Fnd.Column).Value = Arr(1, 7)
                       Exit Do
                    End If
                    Set Fnd = Target.FindNext(Fnd)
                    If Not Fnd Is Nothing Then
                        If Fnd.Row = FirstFound Then Set Fnd = Nothing
                    End If
                Loop While Not Fnd Is Nothing
            End If

            If Fnd Is Nothing Then
                With WsT
                    Rt = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                    .Rows(Rt - 1).Copy
                    .Rows(Rt).Insert Shift:=xlDown
                    .Rows(Rt).ClearContents
                    .Cells(Rt, 1).Value = .Cells(Rt - 1, 1).Value + 1
                    For C = 2 To 4
                        .Cells(Rt, C).Value = Arr(1, C)
                    Next C
                    .Cells(Rt, Ct).Value = Arr(1, 7)
                End With
            End If
        Next Rs
    End With
    Application.ScreenUpdating = True
End Sub

The code should be in your file "bb". It must be in a standard code module, not any of the code modules provided by Excel automatically.

If the source workbook isn't open the code will open it. The procedure will look for a match in column B (that's Columns(2)) and skip that match if the other two columns are different. If no match is found a row is appended, taking the formats from the last previously existing row. If you run the code again (in error), the results of the second run will be written to the next column.

Discuss

Discussion

I no  know   where is  the  problem  , it  gives me  error   object variable  or with block variable  not  set  in this  line 
Set WsS = WbS.Worksheets("Sheet1")
i  do not  change  anything  the  same  data  also  I   uploaded  your  file   it's  very  strange  ,  do  you  have  any  idea?
MAKLIL (rep: 34) Mar 2, '21 at 11:23 pm
The reason is that the name or path of the source workbook isn't set correctly. You can futher drill down. Open the workbook. Then run the code. If the error persists the name of the workbook is wrong. If the code works in that mode the meaning is that the path is wrong. Both are set in the constants at the top of the code. As I said in my answer, these two items must be set by you, even when trying the code in my workbook.
Variatus (rep: 4889) Mar 3, '21 at 8:06 am
Brilliant !   you're  right  about    my  path   actually i'm  sure   the  path  is  right  but  a  simple  detail  makes   the  code   is  disabled  , I'v  found  space  before slash  , I  fixed  it  and  works   excellantly   just     I ask  if  you  can  fix  this  problem  I  note  if  I   clear  some  data  in  file  bb  to  I  see how  the  code  adds  the  brands  are  not  existed in  file  bb and  are  existed in  file   aa   ,  actually  the code  adds  them  but  after   the  empty  rows  what  I  cleared   it  should  replace  the  empty  rows  but   not  under them   I  appreciate  your  assistance  thanks   so  much
MAKLIL (rep: 34) Mar 3, '21 at 8:36 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login