Solved: Fast Cut and Paste

[Imdabaum]

I've found a few examples of cutting and pasting, but as most of my previous posts show, I'm a beginner when it comes to Excel and none of the copy/cut paste examples involved conditions.

I have a sheet with about 6k-10k rows of data. Many of these are duplicates and in order to identify the duplicates I simply create a new column and fill down so A1=(B1=B2), A2=(B2=B3), A3=(B3=B4) etc..

This gives me a column of True values where the data is exactly the same as the row below it.

We don't delete these items, but cut and paste them to the bottom of the list with a row separator.
So the sheet ends up looking like this:

{list}
blank row
{deleted items}

So is there a fast way to say,

If A#= True, Row.Select, Row.Cut, Goto Last line below separator, Row.Paste and repeat until it reaches the separator?

[geekgirlau]

Before looking at a method to cut and paste the data, I'd be exploring other options:

• Determine the first record for the field that you are testing (you can basically do this using the formula you have right now). You can then filter the list to only show the first record, and copy those records to a separate sheet.
• Is it only one field that is duplicated? If it's the whole record, you can perform an advanced filter to show unique records only, then copy those to a separate sheet.
• Is is absolutely necessary to keep the duplicates? What purpose does it serve?

Personally I've not a fan of having the data categorised by where it sits on the sheet. You end up wasting too much time moving records around, where a simple filter would be far more effective.

Keep in mind that often we get hung up on how to do something in a specific way, when in fact we should question the process and assumptions that we are using. Find the most efficient process first, THEN automate it.

[Artik]

Try it:[vba]Sub Filter_unique()
Dim rngData As Range
Dim rngDataToCopy As Range
Dim rngFirstEpmtyRow As Range
Dim WksIn As Worksheet
Dim WksOut As Worksheet

On Error GoTo Filter_unique_Error

'Table without headers!!


Set rngData = Range("A1").CurrentRegion
Set WksIn = rngData.Parent '(ActiveSheet)

With rngData.Offset(, rngData.Columns.Count).Columns(1)
'insert column after data
.EntireColumn.Insert

'fill the column formulas
.Offset(, -1).Formula = "=A1=A2"
End With

Rows(1).Insert

'Insert header in cell A1
rngData.Cells(1).Offset(-1).Value = "XXXXXXX"

'Filter only the first unique records in the first column of data (Advanced Filter)
Union(rngData.Cells(1).Offset(-1), rngData.Columns(1)).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True

'Only the visible cells
Set rngDataToCopy = rngData.SpecialCells(xlCellTypeVisible)

'Add a new worksheet
Set WksOut = ActiveWorkbook.Worksheets.Add(after:=WksIn)

'Copy and paste the filtered data
rngDataToCopy.Copy WksOut.Range("A1")

Set rngFirstEpmtyRow = WksOut.Cells(Rows.Count, 1).End(xlUp).Offset(2)

'reset AdvancedFilter
WksIn.ShowAllData

'Filter column with formulas only records the value TRUE (Autofilter)
rngData.Cells(1).Offset(-1).AutoFilter Field:=rngData.Columns.Count + 1, Criteria1:=True

'Only the visible cells
Set rngDataToCopy = rngData.SpecialCells(xlCellTypeVisible)

'Copy and paste the filtered data
rngDataToCopy.Copy rngFirstEpmtyRow

'Remove column with formulas
rngData.Offset(, rngData.Columns.Count).Columns(1).EntireColumn.Delete

'Remove the first row
rngData.Cells(1).Offset(-1).EntireRow.Delete

Filter_unique_Exit:
On Error GoTo 0

Set rngData = Nothing
Set rngDataToCopy = Nothing
Set rngFirstEpmtyRow = Nothing
Set WksIn = Nothing
Set WksOut = Nothing

Exit Sub

Filter_unique_Error:

MsgBox "Error " & Err.Number & vbCr & _
"(" & Err.Description & ")" & vbCr & _
"in procedure Filter_unique1"
Resume Filter_unique_Exit
End Sub[/vba]
Artik

[mdmackillop]

[VBA]
Option Explicit
Sub SortDups()
Dim rng As Range
Dim c As Range
Columns(1).Insert
Set rng = Cells(1, 2).CurrentRegion.Columns(1).Offset(, -1)
rng.FormulaR1C1 = "=R[]C[1] = R[1]C[1]"
rng.Value = rng.Value
ActiveSheet.Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange rng
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set c = rng.Find("TRUE")
c.EntireRow.Insert
'Columns(1).Delete
End Sub
[/VBA]

[Artik]

mdmackillop
It is beautiful.

For all versions of Excel:[VBA]Sub SortDups_1()
Dim rng As Range
Dim c As Range
Columns(1).Insert
Set rng = Cells(1, 2).CurrentRegion.Columns(1).Offset(, -1)
rng.FormulaR1C1 = "=R[]C[1] = R[1]C[1]"
rng.Value = rng.Value

rng.CurrentRegion.Sort rng(1), Order1:=xlAscending, Header:=xlNo
Set c = rng.Find("TRUE")
c.EntireRow.Insert
'Columns(1).Delete
End Sub[/VBA]
Thanks.

Artik

[Imdabaum]

Before looking at a method to cut and paste the data, I'd be exploring other options:

• Determine the first record for the field that you are testing (you can basically do this using the formula you have right now). You can then filter the list to only show the first record, and copy those records to a separate sheet.
• Is it only one field that is duplicated? If it's the whole record, you can perform an advanced filter to show unique records only, then copy those to a separate sheet.
• Is is absolutely necessary to keep the duplicates? What purpose does it serve?

Yes, we need to keep them. I am a big fan of categorizing data by sheets and it currently does, but where I would separate this tab into 2 more tabs to join the other 14, she wants it to stay together.

The reason we keep the data is because the entire row is not duplicated, only B which holds the names of company, the other columns have data regarding logs, comments related to the company. So we later have to determine if that company was entered into the system more than once and we need to create a new company, or if the company was already existing and just had multiple logs created against it. In the end we ultimately delete the data, but not at this point.

Keep in mind that often we get hung up on how to do something in a specific way, when in fact we should question the process and assumptions that we are using. Find the most efficient process first, THEN automate it.

Very true.