I want to append names from column g to the end of column A and then remove duplicates

[danyu]

Hi Everyone,

I want to append names from column g to the end of column A and then remove duplicates. I was able to do it this way below, but I feel like this way will be prone to glitching or something. Is there a better way to do this? Also, is there a simple way to have vlookup match with names that have Jr. Sr. etc? I've read that it can be done with vlookup wildcards, but it doesnt seem to work for me. Thanks in advance!

Sheets("Names").Select
Range("G2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveWindow.SmallScroll Down:=18
Range("A700").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$1500").RemoveDuplicates Columns:=1, Header:=xlYes

 

[Legacy 143009]

How about this?

Sub myFunction()
  Dim gRow As Integer, aRow As Integer

  gRow = Cells(Rows.Count, 7).End(xlUp).Row
  aRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = 2 To gRow
    Cells((aRow + i) - 1, 1).Value =  Cells(i, 7).Value
  Next

  ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

 

[danyu]

How about this?

Sub myFunction()
  Dim gRow As Integer, aRow As Integer

  gRow = Cells(Rows.Count, 7).End(xlUp).Row
  aRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = 2 To gRow
    Cells((aRow + i) - 1, 1).Value =  Cells(i, 7).Value
  Next

  ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

let me try, thanks!

 

[danyu]

How about this?

Sub myFunction()
  Dim gRow As Integer, aRow As Integer

  gRow = Cells(Rows.Count, 7).End(xlUp).Row
  aRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = 2 To gRow
    Cells((aRow + i) - 1, 1).Value =  Cells(i, 7).Value
  Next

  ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

 

[danyu]

Hi, It works! Thanks!

However, I wanted to run one macro and have this run across multiple sheets (each from a column like g to a), when I try using this code on another sheet I get a duplicate error. Is there a way to use this on multiple sheets?

Sheets("names").Select
Dim gRow As Integer, aRow As Integer

gRow = Cells(Rows.Count, 7).End(xlUp).Row
aRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To gRow
Cells((aRow + i) - 1, 1).Value = Cells(i, 7).Value
Next

ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes

Sheets("name2").Select
Dim gRow As Integer, aRow As Integer

gRow = Cells(Rows.Count, 9).End(xlUp).Row
aRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To gRow
Cells((aRow + i) - 1, 1).Value = Cells(i, 9).Value
Next

ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes


Thanks again!

 

[Legacy 143009]

Hi, It works! Thanks!

However, I wanted to run one macro and have this run across multiple sheets (each from a column like g to a), when I try using this code on another sheet I get a duplicate error. Is there a way to use this on multiple sheets?

Sheets("names").Select
Dim gRow As Integer, aRow As Integer

gRow = Cells(Rows.Count, 7).End(xlUp).Row
aRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To gRow
Cells((aRow + i) - 1, 1).Value = Cells(i, 7).Value
Next

ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes

Sheets("name2").Select
Dim gRow As Integer, aRow As Integer

gRow = Cells(Rows.Count, 9).End(xlUp).Row
aRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To gRow
Cells((aRow + i) - 1, 1).Value = Cells(i, 9).Value
Next

ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes


Thanks again!

Hi, gald the hear it did work! Can you provide some sample worksheet names? Or all worksheets?

 

[danyu]

Hi, gald the hear it did work! Can you provide some sample worksheet names? Or all worksheets?

Hi, one tab I have is called Blitz, and another is CBS. I can also do all worksheets in between like a first : end tab.

Thanks again, truly appreciated!

 

[Legacy 143009]

For specific worksheets:

Sub myFunction()
  Dim gRow As Integer, aRow As Integer
  Dim wsheets As Variant
  Dim ws As Variant
 
  wsheets = Array("Blitz", "CBS")

  For Each ws In wsheets
    With ws
      gRow = .Cells(Rows.Count, 7).End(xlUp).Row
      aRow = .Cells(Rows.Count, 1).End(xlUp).Row

      For i = 2 To gRow
         .Cells((aRow + i) - 1, 1).Value =  .Cells(i, 7).Value
      Next

      .Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
    End With
  Next ws
End Sub

To loop through all worksheets:

Sub myFunction()
  Dim gRow As Integer, aRow As Integer
  Dim ws As Worksheet

  For Each ws In ThisWorkbook.Worksheets
    With ws
      gRow = .Cells(Rows.Count, 7).End(xlUp).Row
      aRow = .Cells(Rows.Count, 1).End(xlUp).Row

      For i = 2 To gRow
         .Cells((aRow + i) - 1, 1).Value =  .Cells(i, 7).Value
      Next

      .Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
    End With
  Next
End Sub

 

[HaHoBe]

Hi danju,

maybe

Sub MrE1222800()
Dim lngCount As Long
Dim lngIndex As Long

'will work on all sheets from First to Last
For lngIndex = Worksheets("First").Index To Worksheets("Last").Index
  With Worksheets(lngIndex)
     lngCount = .Cells(.Rows.Count, "G").End(xlUp).Row - 1
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(lngCount, 1).Value = Range("G2").Resize(lngCount, 1).Value
    .Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
  End With
Next lngIndex
End Sub

Ciao,
Holger

 

[danyu]

For specific worksheets:

Sub myFunction()
  Dim gRow As Integer, aRow As Integer
  Dim wsheets As Variant
  Dim ws As Variant
 
  wsheets = Array("Blitz", "CBS")

  For Each ws In wsheets
    With ws
      gRow = .Cells(Rows.Count, 7).End(xlUp).Row
      aRow = .Cells(Rows.Count, 1).End(xlUp).Row

      For i = 2 To gRow
         .Cells((aRow + i) - 1, 1).Value =  .Cells(i, 7).Value
      Next

      .Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
    End With
  Next ws
End Sub

To loop through all worksheets:

Sub myFunction()
  Dim gRow As Integer, aRow As Integer
  Dim ws As Worksheet

  For Each ws In ThisWorkbook.Worksheets
    With ws
      gRow = .Cells(Rows.Count, 7).End(xlUp).Row
      aRow = .Cells(Rows.Count, 1).End(xlUp).Row

      For i = 2 To gRow
         .Cells((aRow + i) - 1, 1).Value =  .Cells(i, 7).Value
      Next

      .Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
    End With
  Next
End Sub

Thanks! what if they aren't always in the same column? Sometimes the data set is in column F, G , I etc, but I want to copy to A. I was going copy the code for each individual sheet.
Thanks again!