IF True, copy/paste to Sheet"X" in Rage"X:X" in next empty cell

[adtc]

Hello all,

I managed to find this below macro to check for duplicates over multiples sheets.

I was hoping that someone may be able to help me amend it to paste the identified duplicate (whole row) to a a different (existing) sheet (within same workbook) in a particular range, beginning on the next empty row.

For example:

if duplicate, then copy whole row to sheet "Duplicates" in range A3:A10.
but if there is something in A3, then go to A4 and paste etc.

Thank you very much for any help or feedback.
My boss thanks you too


Sub findDuplicates()
' code to find duplicates in 2 different worksheets
Dim rng1, rng2, cell1, cell2 As Range
' 4 ranges have been defined
Set rng1 = Worksheets("Sheet1").Range("B:B")
'rng1 defines the existing data in column B and worksheet1
Set rng2 = Worksheets("Sheet2").Range("D:D")
'rng2 defines the imported data in column D and worksheet2
For Each cell1 In rng1
If IsEmpty(cell1.Value) Then Exit For
'check for empty rows. If true then exit the program
For Each cell2 In rng2
If IsEmpty(cell2.Value) Then Exit For
If cell1.Value = cell2.Value Then
'compare data in cell1 and cell2 and then format if they have equal values.
cell1.Font.Bold = True
cell1.Font.ColorIndex = 2
cell1.Interior.ColorIndex = 3
cell1.Interior.Pattern = xlSolid
cell2.Font.Bold = True
cell2.Font.ColorIndex = 2
cell2.Interior.ColorIndex = 3
cell2.Interior.Pattern = xlSolid
End If
'run the looping process
Next cell2
Next cell1
End Sub

 

[Akinrotimi]

1. Create sheet duplicates
2. Run the macro below:

===============================

Application.ScreenUpdating = False
Sheets("sheet1").Select
Columns("b:b").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("sheet2").Select
Columns("d:d").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
' code to find duplicates in 2 different worksheets
Dim rng1, rng2, cell1, cell2 As Range
' 4 ranges have been defined
Set rng1 = Worksheets("Sheet1").Range("B:B")
'rng1 defines the existing data in column B and worksheet1
Set rng2 = Worksheets("Sheet2").Range("D:D")
'rng2 defines the imported data in column D and worksheet2
For Each cell1 In rng1
If IsEmpty(cell1.Value) Then Exit For
'check for empty rows. If true then exit the program
For Each cell2 In rng2
If IsEmpty(cell2.Value) Then Exit For
If cell1.Value = cell2.Value Then
'compare data in cell1 and cell2 and then format if they have equal values.
cell1.Font.Bold = True
cell1.Font.ColorIndex = 2
cell1.Interior.ColorIndex = 3
cell1.Interior.Pattern = xlSolid
cell2.Font.Bold = True
cell2.Font.ColorIndex = 2
cell2.Interior.ColorIndex = 3
cell2.Interior.Pattern = xlSolid
End If
'run the looping process
Next cell2
Next cell1
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Select
ActiveCell.FormulaR1C1 = "HEADER"
Range("D1").Select
Selection.Copy
Sheets("Sheet1").Select
Rows("1:1").Select
Range("B1").Select
Range("B4").Select
Application.CutCopyMode = False
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Select
Sheets("Sheet2").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("B:B").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add(Range( _
"B1:B25000"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(255, 0, 0)
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("a25000").Select
ActiveCell.FormulaR1C1 = "QWERTY1248"
Range("D9").Select
ActiveSheet.Range("$B$1:$B$25000").AutoFilter Field:=1, Criteria1:=RGB(255 _
, 0, 0), Operator:=xlFilterCellColor
Sheets("Sheet2").Select
ActiveSheet.Range("$D$1:$D$25000").AutoFilter Field:=1, Criteria1:=RGB(255, 0 _
, 0), Operator:=xlFilterCellColor
Range("F4").Select


Sheets("Sheet1").Select

Rows("1:25000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("duplicates").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Sheet1").Select
Application.CutCopyMode = False
Range("D3").Select
Sheets("Sheet2").Select

Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$D$1:$D$25000").AutoFilter Field:=1, Criteria1:=RGB(255, 0 _
, 0), Operator:=xlFilterCellColor
Range("A1").Select


Range("a25001").Select
ActiveCell.FormulaR1C1 = "QWERTY1248"

Rows("2:25001").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("duplicates").Select
Range("A40000").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste

Range("a1:z30000").Select
Selection.Replace What:="qwerty1248", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("Sheet1").Select
Rows("1:1").Select
Selection.Delete


Sheets("Sheet2").Select
Rows("1:1").Select
Selection.Delete


Cells.Select
Selection.Replace What:="qwerty1248", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.AutoFilter
Range("A1").Select
Sheets("Sheet1").Select
Range("A25002").Select
ActiveCell.FormulaR1C1 = "qwerty1248"
Cells.Select
Selection.AutoFilter
Cells.Select
Selection.Replace What:="qwerty1248", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Sheets("duplicates").Select


Range("A25002").Select
ActiveCell.FormulaR1C1 = "qwerty1248"
Cells.Select
Selection.AutoFilter
Cells.Select
Selection.Replace What:="qwerty1248", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


Columns("a:a").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Sheets("Sheet1").Select
Selection.AutoFilter
Range("A1").Select
Sheets("Sheet2").Select
Selection.AutoFilter
Rows("1:1").Select
Range("A1").Select

Sheets("duplicates").Select
Range("A1").Select
Application.ScreenUpdating = true

=====================================

Regards

Rotimi

 

[adtc]

Thank you so much!
You're a legend!
works a treat!

 

[zuki01]

Hi,

I tried to use this and adapt it a bit. I have formulae giving a value in column D and true/false in E.

If true paste column D over itself as a value but if false leave the cells (in column D) alone as formula.

Is this possible, I've tried everything I can think of and it seems to be just unachievable but sounds so simple in my head haha.