Need to create single list based on data stored in different worksheets, no duplicates

Feicstur,

Welcome to the Excel Forum.

To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed/changed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.

Feicstur,

Detach/open workbook GetUniques w2 w3 A2A34 w1 ScriptingDictionary - Feicstur - EF983632 - SDG15.xlsm and run the GetUniques macro.


If you want to use the macro on another workbook with the identical setup, but, with different data:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub GetUniques()
' stanleydgromjr, 01/22/2014, EF983632
Dim rng As Range, c As Range, k
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  Set rng = Sheets("Sheet2").Range("A2:A34")
  For Each c In rng
    If Not .Exists(c.Value) Then
      .Add c.Value, c.Value
    End If
  Next
  Set rng = Sheets("Sheet3").Range("A2:A34")
  For Each c In rng
    If Not .Exists(c.Value) Then
      .Add c.Value, c.Value
    End If
  Next
  k = Application.Transpose(Array(.keys))
End With
With Sheets("Sheet1")
  .Range("A2").Resize(UBound(k, 1), UBound(k, 2)) = k
  .Range("A2:A" & UBound(k, 1)).Sort key1:=Range("A2"), order1:=1
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetUniques macro.

Feicstur,

Thanks for the feedback.

You are very welcome. Glad I could help.

I am noticing that when I edit the lists that feed the master list I get blanks sometimes, I am also trying to have the output go into several columns (example: A2:A50, B2:B50, C2:C50) Any thoughts?

In order to continue I will have to see your actual raw data workbook, with the raw data in its worksheets
Sheet2 and Sheet3, and, the results in Sheet1 (manually formatted by you for the results you are looking for).


To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed/changed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.


If you are not able to supply your workbook, per the above, then:

In the Quick Reply box, just put the word BUMP. Then, click on the Post Quick Reply button, and someone else will assist you.

Feicstur,

Thanks for the workbook.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub GetUniquesV2()
' stanleydgromjr, 01/24/2014, EF983632
Application.Run ("ClearCell")
Dim rng As Range, c As Range, k
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  Set rng = Sheets("Global Parameters").Range("L56:L71,O56:O71")
  For Each c In rng
    If c <> "" Then
      If Not .Exists(c.Value) Then
        .Add c.Value, c.Value
      End If
    End If
  Next
  Set rng = Sheets("Unit 1 Consoles").Range("Z1:Z96")
  For Each c In rng
    If c.Value <> 0 Then
      If Not .Exists(c.Value) Then
        .Add c.Value, c.Value
      End If
    End If
  Next
  k = Application.Transpose(Array(.keys))
End With
With Sheets("Master Tag Message List")
  .Range("A2").Resize(UBound(k, 1), UBound(k, 2)) = k
  .Range("A2:A" & UBound(k, 1)).Sort key1:=Range("A2"), order1:=1
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Assign the new macro to your command button Update Messages List.

Then run the GetUniquesV2 macro, by clicking on the command button Update Messages List.

very nice! thanks!

Am I pressing my luck if I ask for output to 3 columns (A2:C50)?

Feicstur,

Thanks for the feedback.

You are very welcome. Glad I could help.

Am I pressing my luck if I ask for output to 3 columns (A2:C50)?

Let me look at the workbook again - be back later.

Feicstur,

Range A2:C50 will hold 147 items.

After the unique items are found, and, downloaded beginning in range A2, and, sorted, they could be moved to fit in the given range A2:C50.

1. What happens if the count goes above 147 items?

2. Can I have another workbook that will have more than 49 unique items?

Feicstur,

Thanks for the new workbook.

I have updated/renamed both macros, and, assigned them to the two command buttons.

Detach workbook GetUniquesV3 SandboxRev1 w2 w3 A2A34 w1 ScriptingDictionary - Feicstur - EF983632 - SDG15.xlsm and run the GetUniquesV3 macro, and, or, the ClearCellV2 macro, by clicking on the two command buttons.


And, in both macros, the new code is using the actual worksheet names.

If you want to use the two macros in another workbook with the same worksheet names, you will have to assign the new macros to the two command buttons.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub GetUniquesV3()
' stanleydgromjr, 01/28/2014, EF983632
Application.Run ("ClearCellV2")
Dim rng As Range, c As Range, k
Dim lr As Long, n As Long, sr As Long, i As Long, nc As Long
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  Set rng = Sheets("Global Parameters").Range("L56:L71,O56:O71")
  For Each c In rng
    If c <> "" Then
      If Not .Exists(c.Value) Then
        .Add c.Value, c.Value
      End If
    End If
  Next
  lr = Sheets("Unit 1 Consoles").Cells(Rows.Count, "Z").End(xlUp).Row
  Set rng = Sheets("Unit 1 Consoles").Range("Z1:Z" & lr)
  For Each c In rng
    If c.Value <> 0 Then
      If Not .Exists(c.Value) Then
        .Add c.Value, c.Value
      End If
    End If
  Next
  k = Application.Transpose(Array(.keys))
End With
With Sheets("Master Tag Message List")
  .Range("A2").Resize(UBound(k, 1), UBound(k, 2)) = k
  lr = .Cells(Rows.Count, "A").End(xlUp).Row
  .Range("A2:A" & lr).Sort key1:=.Range("A2"), order1:=1
  n = Application.Ceiling(lr, 49)
  nc = 1
  sr = 51
  For i = sr To n Step 49
    nc = nc + 1
    .Cells(2, nc).Resize(49).Value = .Cells(i, 1).Resize(49).Value
  Next i
  .Range("A" & sr & ":A" & n).ClearContents
  .Activate
End With
End Sub

Option Explicit
Sub ClearCellV2()
' stanleydgromjr, 01/28/2014, EF983632
With Sheets("Master Tag Message List")
  .Range("A2:C50").ClearContents
  .Range("A2").Select
End With
End Sub

Before you use the macros with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

kayegap,

Welcome to the Excel Forum.


Your data structure is completely different from Feicstur's data structure.


Please do not post your questions in threads started by others - - this is known as thread hijacking.

Always start a new thread for your questions and, if you think it helps, provide a link to any other thread as a reference.

Start a new thread for your question and be sure to give it a search friendly title that accurately describes your need.

After you start a NEW thread, then send me a Private Message with a link to your NEW thread, and, I will have a look.