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?

Which column no is the same on both sheets and what is in the cells, numbers, dates or character strings ? Please give a couple of examples. — CDP1802
Where, in Sheet1, to copy data from L:L column of Sheet1? You only said to be column I:I. To copy values after the last row keeping a value? Isn't it necessary to find a match between the two ranges and paste the value to the equivalent key of Sheet1? Can you better explain this part of your question? Some pictures (at least, editable will be better) presenting something relevant, from this point of view, will be also OK, but not mandatory, if your explanation will be good enough. Besides all that, do you have a piece of code you tried by your own, to be improved here? — FaneDuru
Sorry that i didn't provide any images, but you can see it here for sheet 1 and sheet 2 Sheet 1: imgur.com/a/FeKTpMH Sheet 2: imgur.com/a/JEdCTXu The code i tried, posted values in blank cells which is not what i need.. — user1338133
If sheet2 value is blank do you want it to remove the value on sheet 1 ? — CDP1802
<blink> Sub Copy() Dim c As Range Dim j As Integer Dim Source As Worksheet Dim Target As Worksheet ' Change worksheet designations Set Source = ActiveWorkbook.Worksheets("Sheet2") Set Target = ActiveWorkbook.Worksheets("Sheet1") J = 1 ' Start copying to row 1 in target sheet For Each c In Source.Range("L2:L1000") ' Do 1000 rows If c > 0 Then Source.Rows(c.Row).Copy Target.Rows(j) j = j + 1 End If Next c End Sub </blink> — user1338133

CDP1802 CDP1802 · Accepted Answer · 2020-02-10T16:59:57

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

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

1 Answers