Replace range of data if target value already exists - vba

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