Search delete copy-N-paste to new sheet not working....

andre30331

New Member
Joined
May 14, 2014
Messages
29
Hello,

I have code that when I select column B the script looks through column B for duplicate values among unique numerical strings of data. When a duplicate is located the code should delete the entire row without scrambling or re-sorting the data set and copy the final result of the entire sheet inclusive of columns A:E to a new sheet.


  1. The first issue I am having is instead of coping the final results and the data from columns A thru E onto the new sheet it only copies the value of column B to all other columns on the new sheet.Column B data rereated in cloumn A,C,D,& E
  2. The second issues is I would simply like to run the code and it search through column B without having to actually select column B for the code to work.
Thanks in advance for helping.

Code:
Option Explicit


Sub List_Unique_Values()


Dim rSelection As Range
Dim ws As Worksheet
Dim vArray() As Long
Dim i As Long
Dim iColCount As Long


  
  If TypeName(Selection) <> "Range" Then
    MsgBox "Please select a range first.", vbOKOnly, "List Unique Values Macro"
    Exit Sub
  End If
  
  
  Set rSelection = Selection


 
  Set ws = Worksheets.Add
  
  
  rSelection.Copy
  
  With ws.Range("A:E")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    '.PasteSpecial xlPasteValuesAndNumberFormats
  End With
  


  iColCount = rSelection.Columns.Count
  ReDim vArray(1 To iColCount)
  For i = 1 To iColCount
    vArray(i) = i
  Next i
  
  'Remove duplicates
  ws.UsedRange.RemoveDuplicates Columns:=vArray(i - 1), Header:=xlGuess
  
  
  On Error Resume Next
    ws.UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
  On Error GoTo 0
  
  
  ws.Columns("A").AutoFit
  


  Application.CutCopyMode = False
    
End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
.
Try this :

Code:
Option Explicit


Sub DeleteDups()
     
    Dim x               As Long
    Dim LastRow         As Long
    Dim Cells           As Range
    Application.ScreenUpdating = False
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        LastRow = LastRow
    End With
 
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("B1:B" & x), Range("B" & x).Text) > 1 Then
            Range("B" & x).EntireRow.Delete
        End If
    Next x
    Application.ScreenUpdating = True
    
    CpyPaste
   
End Sub




Sub CpyPaste()
Dim lRow As Long
Dim sht As Worksheet
Set sht = ActiveSheet    'x.Sheets("SheetName")


Application.ScreenUpdating = False


lRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row


sht.Range("A1:E" & lRow).Copy
Sheet2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False


Sheet1.Range("A1").Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0
.
Try this :

Code:
Option Explicit


Sub DeleteDups()
     
    Dim x               As Long
    Dim LastRow         As Long
    Dim Cells           As Range
    Application.ScreenUpdating = False
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        LastRow = LastRow
    End With
 
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("B1:B" & x), Range("B" & x).Text) > 1 Then
            Range("B" & x).EntireRow.Delete
        End If
    Next x
    Application.ScreenUpdating = True
    
    CpyPaste
   
End Sub




Sub CpyPaste()
Dim lRow As Long
Dim sht As Worksheet
Set sht = ActiveSheet    'x.Sheets("SheetName")


Application.ScreenUpdating = False


lRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row


sht.Range("A1:E" & lRow).Copy
Sheet2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False


Sheet1.Range("A1").Select
Application.ScreenUpdating = True
End Sub

Thanks Logit. The remove duplicates code seems to work fine but the copy/paste code should create a new sheet to place the data when the code is run. Currently it shows an error if the workbook previously had a sheet2 that may have been deleted. If i create a new sheet2 before running the code the new sheet2 is actually sheet3(sheet2) in visual basic.
 
Last edited:
Upvote 0
.
Change the CpyPaste macro to this :

Code:
Sub CpyPaste()
Dim lRow As Long
Dim sht As Worksheet
Set sht = ActiveSheet


Application.ScreenUpdating = False


With ThisWorkbook
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Data Update"
End With




lRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row


sht.Range("A1:E" & lRow).Copy
Sheets("Data Update").Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False


Sheets("Data Update").Range("A1").Select
'Sheet1.Range("A1").Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks Logit. The remove duplicates code seems to work fine but the copy/paste code should create a new sheet to place the data when the code is run. Currently it shows an error if the workbook previously had a sheet2 that may have been deleted. If i create a new sheet2 before running the code the new sheet2 is actually sheet3(sheet2) in visual basic.


That worked.... Thank you
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,239
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top