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]

Do you have a specific column header for that?

 

[HaHoBe]

Hi danyu,

if sheets and columns are always the same for the code to run on:

Sub MrE_1222800_161460A()
Dim lngCount As Long
Dim lngIndex As Long
Dim strSheets As String
Dim strCols As String
Dim varSheets As Variant
Dim varCols As Variant

'adjust sheetnames and columns
strSheets = "First|Last|Home|Everywhere"
strCols = "G|I|C|L"

varSheets = Split(strSheets, "|")
varCols = Split(strCols, "|")
If UBound(varCols) <> UBound(varSheets) Then
  MsgBox "Please check sheetnames and Columns as they do not have the same number", vbInformation, "Ending here..."
  Exit Sub
End If

For lngIndex = LBound(varSheets) To UBound(varSheets)
  With Worksheets(varSheets(lngIndex))
     lngCount = .Cells(.Rows.Count, varCols(lngIndex)).End(xlUp).Row - 1
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(lngCount, 1).Value = .Cells(2, varCols(lngIndex)).Resize(lngCount, 1).Value
    .Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
  End With
Next lngIndex
End Sub

Ciao,
Holger

 

[Legacy 143009]

For specific sheets:

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

  For Each ws In wSheets
    With ws
      c = Application.WorksheetFunction.Match("Names", .Rows(1), 0) 'Replace with your column header
      gRow = .Cells(Rows.Count, c).End(xlUp).Row
      aRow = .Cells(Rows.Count, 1).End(xlUp).Row

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

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

For all sheets:

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

  For Each ws In ThisWorkbook.Worksheets
    With ws
      c = Application.WorksheetFunction.Match("Names", .Rows(1), 0) 'Replace with your column header
      gRow = .Cells(Rows.Count, c).End(xlUp).Row
      aRow = .Cells(Rows.Count, 1).End(xlUp).Row

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

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

 

[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

When I tried the first code (for specific sheets) I got this issue:

Do you have any ideas on how to fix this please? Thanks!

 

[danyu]

Hi danyu,

if sheets and columns are always the same for the code to run on:

Sub MrE_1222800_161460A()
Dim lngCount As Long
Dim lngIndex As Long
Dim strSheets As String
Dim strCols As String
Dim varSheets As Variant
Dim varCols As Variant

'adjust sheetnames and columns
strSheets = "First|Last|Home|Everywhere"
strCols = "G|I|C|L"

varSheets = Split(strSheets, "|")
varCols = Split(strCols, "|")
If UBound(varCols) <> UBound(varSheets) Then
  MsgBox "Please check sheetnames and Columns as they do not have the same number", vbInformation, "Ending here..."
  Exit Sub
End If

For lngIndex = LBound(varSheets) To UBound(varSheets)
  With Worksheets(varSheets(lngIndex))
     lngCount = .Cells(.Rows.Count, varCols(lngIndex)).End(xlUp).Row - 1
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(lngCount, 1).Value = .Cells(2, varCols(lngIndex)).Resize(lngCount, 1).Value
    .Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
  End With
Next lngIndex
End Sub

Ciao,
Holger

Hi Holger,

I tried your code and I got this error:

Could you please help me figure out what I did wrong?
Thanks!

 

[Legacy 143009]

When I tried the first code (for specific sheets) I got this issue:

View attachment 79556

View attachment 79557

Do you have any ideas on how to fix this please? Thanks!

Change this line

wsheets = Array("Blitz", "CBS")

to this

wSheets = Array("Blitz", "CBS")

capital S

 

[danyu]

Change this line

wsheets = Array("Blitz", "CBS")

to this

wSheets = Array("Blitz", "CBS")

capital S

Change this line

wsheets = Array("Blitz", "CBS")

to this

wSheets = Array("Blitz", "CBS")

capital S

Hi, I really appreciate your patience in helping me.

I've changed to capital S but I still get the same error. (I get an error with your newer code with the headers as well).

Thanks
Daniel

 

[HaHoBe]

Hi Daniel,

1004 is the error which is causes the most trouble to spot. It would be a good idea to display the look of one of the sheets which raises the error (if possible using XL2BB) or giving us a download to a copy of the workbook on a free downloader site like dropbox.

@Flashbond:

maybe the error lies in using only ws

  For Each ws In wSheets
    With ws

as ws should only hold the name of a worksheet but not a reference to it like using

  For Each ws In wSheets
    With Worksheets(ws)

My version of Excel2019 didn't like the first sniplet but accepted the second.

Ciao,
Holger

 

[Legacy 143009]

Hi Daniel,

1004 is the error which is causes the most trouble to spot. It would be a good idea to display the look of one of the sheets which raises the error (if possible using XL2BB) or giving us a download to a copy of the workbook on a free downloader site like dropbox.

@Flashbond:

maybe the error lies in using only ws

  For Each ws In wSheets
    With ws

as ws should only hold the name of a worksheet but not a reference to it like using

  For Each ws In wSheets
    With Worksheets(ws)

My version of Excel2019 didn't like the first sniplet but accepted the second.

Ciao,
Holger

Yeah, they are just strings aren't they? Sometimes I make such mistakes. @danyu try like that:

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

  For Each ws In wSheets
    With Worksheets(ws)
      c = Application.WorksheetFunction.Match("Names", .Rows(1), 0) 'Replace with your column header
      gRow = .Cells(Rows.Count, c).End(xlUp).Row
      aRow = .Cells(Rows.Count, 1).End(xlUp).Row

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

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

 

[danyu]

Yeah, they are just strings aren't they? Sometimes I make such mistakes. @danyu try like that:

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

  For Each ws In wSheets
    With Worksheets(ws)
      c = Application.WorksheetFunction.Match("Names", .Rows(1), 0) 'Replace with your column header
      gRow = .Cells(Rows.Count, c).End(xlUp).Row
      aRow = .Cells(Rows.Count, 1).End(xlUp).Row

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

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

Hi, sorry I've been swamped with other work related stuff and I had to put this on hiatus. I just took a look at it now, and it seems to work! Thanks so much! I'll follow up with any questions but I think this might be it.

Thanks again!