Copy cells from one sheet to another if cell contains a value greater than zero

Question

I am quite new to VBA programming, and i am facing a huge workbook, where: Sheet 1 contains around 40k rows of data and 40 columns of data. Sheet 2 contains around 550 rows of data and 15 columns of data. What i have done with the data in the two sheets is that i have made them as a table, and then i have searched "A to Z" in both tables on the same column.

What i then want to do is copy data(only values) from Sheet 2, column 12(L) to Sheet 1, column 9(I) but it should only copy it Sheet 1, column 9(I) contains a value.

I have tried with some different code, but it doesn't seem to work, do you guys have any suggestions?

Answer 1

Matching values from rows in small list to large lists can be done using Dictionary Object . Build the dictionary from the match column on the small list using the cell value as the key and the row number as the value. Then scan down the large list and use the .exists(key) method to determine if a matching value exists. If a dictionary key exists then the dictionary value gives you the row number of the small list.

This sub matches rows on sheet1 with those on sheet2 that have the same column A values. For a matched row the column I value on sheet 1 is replaced with the column L value from sheet 2 providing both columns have a value.

Sub MyCopy()

  Const SOURCE As String = "Sheet2"
  Const TARGET As String = "Sheet1"
  Const COL_MATCH = "A"
  Const COL_SOURCE = "L"
  Const COL_TARGET = "I"

  Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
  Set wb = ThisWorkbook
  Set wsTarget = wb.Sheets(TARGET)
  Set wsSource = wb.Sheets(SOURCE)

  Dim iLastTargetRow As Long, iLastSourceRow As Long, iRow As Long
  iLastSourceRow = wsSource.Range(COL_MATCH & Rows.Count).End(xlUp).Row
  iLastTargetRow = wsTarget.Range(COL_MATCH & Rows.Count).End(xlUp).Row

  ' build lookup to row number from source sheet match column
  Dim dict As Object, sKey As String, sValue As String
  Set dict = CreateObject("Scripting.Dictionary")

  With wsSource
  For iRow = 1 To iLastSourceRow
      If .Range(COL_SOURCE & iRow).Value <> "" Then
          sKey = CStr(.Range(COL_MATCH & iRow).Value)
          If dict.exists(sKey) Then
              Debug.Print "Duplicate", sKey, iRow, dict(sKey)
          Else
              dict.Add sKey, iRow
          End If
      End If
  Next
  End With

  ' scan target sheet
  Dim countMatch As Long, countUpdated As Long
  With wsTarget
  For iRow = 1 To iLastTargetRow
      If .Range(COL_TARGET & iRow).Value <> "" Then

          ' match with source file
          sKey = CStr(.Range(COL_MATCH & iRow).value)
          If dict.exists(sKey) Then
              .Range(COL_TARGET & iRow).Value = wsSource.Range(COL_SOURCE & dict(sKey)).Value
              countUpdated = countUpdated + 1
              'Debug.Print iRow, sKey, dict(sKey)
          End If
          countMatch = countMatch + 1
      End If
  Next
  End With

  ' result
  Dim msg As String
  msg = "Matched = " & countMatch & vbCrLf & _
        "Updated = " & countUpdated

  MsgBox msg, vbInformation, "Completed"

End Sub