Category: Office

Using VBA Macro to Copy data from one Excel workbook to another using string comparison

  1. Option Explicit

Code that handles the copying
Takes every value in Column A of the Destination and checks if it exists column A of the Source file if a match occurs takes the value of column B of the same row and copies it in the column B of the Destination file in the same row of the original compared value

  1. Sub Button2_Click()
  2. Dim wbSrc As Workbook
  3. Dim wsSrc As Worksheet
  4. Dim wbDest As Workbook
  5. Dim wsDest As Worksheet
  6. Dim cmpstr As String
  7. Dim valuestr As String
  8. Dim rowIndex As Integer
  9. Dim totalRows As Integer
  10. Dim result_Index As Long
  11. Dim file_name As String
  12. Dim LastRow As Long
  13. file_name = get_File_Name("Old")
  14. If file_name <> "" Then
  15. Set wbSrc = Workbooks.Open(Filename:=file_name)
  16. Set wsSrc = wbSrc.Worksheets(1)
  17. file_name = get_File_Name("Dest")
  18. 'MsgBox file_name, vbExclamation, "Debug!!!"
  19. If file_name <> "" Then
  20. Set wbDest = Workbooks.Open(Filename:=file_name)
  21. Set wsDest = wbDest.Worksheets(1)
  22. ' Total rows in Column A in destination workbook
  23. totalRows = wsDest.Range("A1").End(xlDown).Row
  24. ' Total rows in Column A in source workbook
  25. LastRow = wsSrc.Range("A1").End(xlDown).Row
  26. ' Loop in destination rows
  27. For rowIndex = 1 To totalRows
  28. cmpstr = wsDest.Cells(rowIndex, 1).Value
  29. ' loop in source rows
  30. For result_Index = 1 To LastRow
  31. If Not IsError(Application.Match(cmpstr, wsSrc.Cells(result_Index, 1), 0)) Then
  32. wsDest.Cells(rowIndex, 2).Value = wsSrc.Cells(result_Index, 2)
  33. End If
  34. Next result_Index
  35. Next rowIndex
  36. wbDest.Save
  37. MsgBox "Users were Successfully copied."
  38. Else
  39. MsgBox "An error has Occured"
  40. End If
  41. Else
  42. MsgBox "An error has Occured"
  43. End If
  44. End Sub

Open dialog function and returns the path to the file or an empty string

  1. Public Function get_File_Name(str As String)
  2. Dim title As String
  3. title = "Please choose the " & str & " Report Excel file"
  4. FileToOpen = Application.GetOpenFilename _
  5. (title:=title, _
  6. FileFilter:="Excel Files *.xlsx (*.xlsx),")
  7. ''
  8. If FileToOpen = False Then
  9. MsgBox "No file specified.", vbExclamation, "Error!"
  10. get_File_Name = ""
  11. Else
  12. get_File_Name = FileToOpen
  13. End If
  14. End Function

I by no way claim this is the best way to do it. If you have better code for this job please share and post code or link of your work in the comment. In that case I would update the code and give you credit for your work.