Separate duplicates and output to other worksheets - vba

Question

I tried to make a program that separates the duplicates and outputs to other worksheets. The data is composed of 3 columns and thousands of rows. First column is a unique number, second column is the material name, and third is the description of the material.
I tried:
Sub duplicates_separation()
Dim duplicate(), i As Long
Dim delrange As Range, cell As Long
Dim delrange2 As Range
Dim shtIn As Worksheet, shtOut As Worksheet
Set shtIn = ThisWorkbook.Sheets("process")
Set shtOut = ThisWorkbook.Sheets("output")
x = 2
y = 1
Set delrange = Range("b1:b30000") 'set your range here
Set delrange2 = Range("c1:c30000")
For cell = 1 To delrange.Cells.Count
If Application.CountIf(delrange, delrange(cell)) > 1 Then
ReDim Preserve duplicate(i)
duplicate(i) = delrange(cell).Address
i = i + 1
End If
Next
For i = UBound(duplicate) To LBound(duplicate) Step -1
Range(duplicate(i)).Value = shtOut.Cells(x, 1).Value
x = x + 1
Next i
End Sub
But it goes to Error 9, Out of Range. It worked before, I don't know why it goes to an error. Anybody know why?
UPDATE
error happen in For i = UBound(duplicate) To LBound(duplicate) Step -1
what i chaged :
from
range(duplicate(i)).entirerow.cut
shtout.cells(x,1).paste
to
Range(duplicate(i)).Value = shtOut.Cells(x, 1).Value
UPDATE It's works now!
Sub duplicates_separation()
Dim duplicate(), i As Long
Dim delrange As Range, cell As Long
Dim delrange2 As Range
Dim shtIn As Worksheet, shtOut As Worksheet
Set shtIn = ThisWorkbook.Sheets("process")
Set shtOut = ThisWorkbook.Sheets("output")
x = 2
y = 1
Set delrange = shtIn.Range("b1:b30000") 'set your range here
Set delrange2 = shtIn.Range("c1:c30000")
'search duplicates in 2nd column
For cell = 1 To delrange.Cells.Count
If Application.CountIf(delrange, delrange(cell)) > 1 Then
ReDim Preserve duplicate(i)
duplicate(i) = delrange(cell).Address
i = i + 1
End If
Next
'search duplicates in 3rd column
For cell = 1 To delrange2.Cells.Count
If Application.CountIf(delrange2, delrange2(cell)) > 1 Then
ReDim Preserve duplicate(i)
duplicate(i) = delrange2(cell).Address
i = i + 1
End If
Next
'add header
shtOut.Cells(1, 1).Resize(1, 3).Value = _
Array("Material Number", "Short Description", "Long Description")
'print duplicates
For i = UBound(duplicate) To LBound(duplicate) Step -1
shtOut.Cells(x, 1).EntireRow.Value = shtIn.Range(duplicate(i)).EntireRow.Value
x = x + 1
Next i
End Sub

Answer 1

This works if you run the code while the sheet that contains the data is selected.
If not, and the sheet currently selected have no value in b1:b30000, then this line:
For i = UBound(duplicate) To LBound(duplicate) Step -1
will produce the Error 9 since you were not able to initialize duplicate variable since you only Redim Preserve when your If statement was satisfied.
To avoid the error, properly declare the variable delrange like this:
Set delrange = shtIn.Range("b1:b30") 'i assumed only that shtIn is the source sheet, change otherwise.
Set delrange2 = shtIn.Range("c1:c30")
and then change this line as well:
For i = UBound(duplicate) To LBound(duplicate) Step -1
shtOut.Cells(x, 1).Value = shtIn.Range(duplicate(i)).Value
x = x + 1
Next i
Again, i assumed that you are writing on shtOut and not the other way around like what you did in your code.