如果目标值已存在，请替换数据范围

Question

The following script selects a range of data on one sheet and transfers the selection to another sheet.

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow

    If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then
        Range(Cells(i, 1), Cells(i, 4)).Select
        Selection.Copy

        erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues

        If Cells(i, 1) <> "" Then Cells(i, 22).Value = "Yes"
        If Cells(i, 22) <> "" Then Cells(i, 23).Value = Now
        If Cells(i, 23) <> "" Then Cells(i, 24).Value = Environ("UserName")
        ActiveWorkbook.Save

    End If
Next i

I would now like to introduce a script which will replace the row of data on the target sheet if the value in column A already exists, but i'm not sure how to achieve this, any help is much appreciated.

Thank you in advance.

Answer 1

Public Function IsIn(li, Val) As Boolean
    IsIn = False
    Dim c
    For Each c In li
        If c = Val Then
            IsIn = True
            Exit Function
        End If
    Next c
End Function

dim a: a= range(destWB.sheet(whatever)..range("A1"),destWB.Range("A" & destWB.sheet(whatever).Rows.Count).End(xlUp)).value
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow
    if isin(a, Cells(i, 1) ) then
    do whatever you want
    else
    If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then
        Range(Cells(i, 1), Cells(i, 4)).Select
        Selection.Copy

        erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues

        If Cells(i, 1) <> "" Then Cells(i, 22).Value = "Yes"
        If Cells(i, 22) <> "" Then Cells(i, 23).Value = Now
        If Cells(i, 23) <> "" Then Cells(i, 24).Value = Environ("UserName")
        ActiveWorkbook.save
    End If    
    End If
Next i

Answer 2

I suggest using a Dictionary -Object which is most likely a Hash-Map . The advantage is that you can use the built in method Dictionary.Exists(Key) to check if the Dictionary already holds the specified value (Key).

Also you should not save the Workbook in every step of the iteration. It would be better (and faster) to only save the workbook after completing the copying of your whole data.

Additionally your If -Tests after copy-paste are not neccessary, because you are already checking for Cells(i,1)<>"" before copying so you don't have to check this again as it does not change.

The following code shows how to get your desired result:

Set dict = CreateObject("Scripting.Dictionary")
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow

  If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then

    If dict.Exists(Cells(i,1).Value) Then
    'value already exists -> update row number
      dict.Item(Cells(i,1).Value)=i
    Else
    'save value of column A and row number in dictionary
      dict.Add Cells(i,1).Value, i
    End If

    Cells(i, 22).Value = "Yes"
    Cells(i, 23).Value = Now
    Cells(i, 24).Value = Environ("UserName")

  End If
Next i

'finally copy over your data (only unique values)
For Each i In dict.Items
    Range(Cells(i, 1), Cells(i, 4)).Select
    Selection.Copy

    erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues
Next i