Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Excel VBA - Transferring data between sheets

I am trying to compare two sheets within one workbook. I need to match values in column A of the first sheet with column A of sheet 2 and, if a matching value is found, copy and paste a value from column E of sheet 2 into column E of sheet 1. For example:

Sheet 1: A    B    C    D    E         Sheet 2:  A    B    C    D    E
         k    9    b    3                        k    d    3    d    6
         j    2    d    4                        m    h    4    g    3
         s    3    u    9                        j    e    8    a    9
         i    4    s    6                        s    i    9    t    7  
         o    7    n    8                        l    b    10   s    9
                                                 i    c    4    p    8
                                                 o    l    0    n    9

Would become

Sheet 1: A    B    C    D    E
         k    9    b    3    6
         j    2    d    4    9
         s    3    u    9    7
         i    4    s    6    8
         o    7    n    8    9

The code I am currently working with is: Sub mergeCategoryValues() Dim lngRow As Long

With ActiveSheet 

lngRow = .Cells(65536, 1).End(xlUp).Row

  .Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes
Do

If .Cells(lngRow, 1) = Sheets("Sheet2").Cells(lngRow, 1) Then
    .Cells(lngRow, 5) = Sheets("Sheet2").Cells(lngRow, 5)
End If

lngRow = lngRow - 1

Loop Until lngRow < 2

End With

End Sub

I need to pull duplicates regardless of case. Is this possible?

Any help is appreciated.

Thank you in advance.

like image 940
Texas2014 Avatar asked Feb 18 '26 00:02

Texas2014


1 Answers

I've worked out a VBA code:

Sub sof20355637MergeCategoryValues()
  Dim i As Long, i2 As Long, lngRow As Long, lngRow2 As Long
  Dim strKey As String
  Dim wks1, wks2 As Worksheet
  Dim objRange2

  Set wks1 = Sheets("Sheet1")
  Set wks2 = Sheets("Sheet2")

  ' get mximum rows of each sheet:
  lngRow = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
  lngRow2 = wks2.Cells(wks1.Rows.Count, 1).End(xlUp).Row

  ' we loop on the first column of sheet1:
  For i = 1 To lngRow
    strKey = wks1.Range("A" & i)
    Set objRange2 = wks2.Range("A:A").Find(strKey, Range("A1"), SearchDirection:=xlPrevious)
    If (Not objRange2 Is Nothing) Then
      i2 = objRange2.Row
      wks1.Range("E" & i) = wks2.Range("E" & i2)
    End If
  Next

  Set objRange2 = Nothing
  Set wks1 = Nothing
  Set wks2 = Nothing

End Sub

With some images:

Sheet1: Sheet2:

enter image description here enter image description here

Merged Sheet1:

enter image description here

like image 52
jacouh Avatar answered Feb 19 '26 14:02

jacouh