FORMULA NEEDED HELP

[Kamal Subhani]

Hi all this is my first post in the forum.


I have a blank sheet and I want to link it to muliple sheets more than 15.

Let say in Sheet1 ColumnB I have the following names :Tom , Jim
In the blank sheet I want Tom ,Jim to be displayed in cell B1 nd B2.

in Sheet2 ColumnB I have the following names :Tom,Marry, John(in B1,B2,B3)
in the Blank sheet in want Tom,Jim,Marry,John to be displayed (in B1,B2,B3,B4)

in Sheet3 Column B I have Kamal,Sharon in cell B1,B2

in BlankSheet I want Tom,Jim,Marry,John,Kamal,Sharaon in cell B1,B2,B3,B4,B5,B6

In actual a lot more names but there is no duplcate enrty in each sheet( names are repeted in different sheets but not in the same columns)

I want to summarize all the names in the Blankshhet Coumn B.

Is there any formula to achive the desired results?

Hope that you will understand my question and some Genius person will solve my problem.

Thanks

 

[Mat]

If I understand what you want, this should work, just replace YourSheetName by the good name, BlankSheet I guess, (This sheet must already exist before running the code)

Sub NameList()
Dim ws As Worksheet
Dim SheetName As String
Dim i As Double, j As Double

'Change YourSheetName by the name of the
'sheet where all the names will be
SheetName = "YourSheetName"

Sheets(SheetName).Select

'Loop to copy all names on the new sheet
For Each ws In Worksheets
    If ws.Name <> SheetName Then
        ws.Range(ws.Range("B1"), ws.Range("B65536").End(xlUp)).Copy
        
        If Sheets(SheetName).Range("B1").Value = "" Then
            Sheets(SheetName).Range("B1").Select
        Else
            Sheets(SheetName).Range("B65536").End(xlUp).Offset(1, 0).Select
        End If
        
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End If
Next

'Loop to erase the names that comes more than once
For i = 1 To Range("B65536").End(xlUp).Row
    For j = i + 1 To Range("B65536").End(xlUp).Row
        If UCase(Cells(i, 2).Value) = UCase(Cells(j, 2).Value) Then
            Cells(j, 2).EntireRow.Delete
            j = j - 1
        End If
    Next j
Next i
 

Range("B1").Select
   
    
End Sub

Hope This Helps,

 

[rrdonutz]

Hi Kamal,

Welcome to the board!

Here is a non-VBA approach. If you install MOREFUNC.XLL (see the "Global Announcement: Recommended Add-ins and Links" topic on the first page of this forum), you can take advantage of its functionality. One possible formula to achieve what you want:

=UNIQUEVALUES(THREED(Sheet2:Sheet18!B1:B50))

which should be entered as an array formula over as many cells (simultaneously) as you think necessary to capture the number of unique items you expect. That is, if you expect 40 possible unique items, highlight a range of cells from B1 to B40 (at least) on your "Blanksheet" and enter the formula above (or an appropriate variation) with 'Ctrl+Shift+Enter'. To edit the formula, select a cell in this array range and press 'Ctrl' + the '/' keys together.

Note: to change the order of unique items to 'ascending', change the formula above to:

=UNIQUEVALUES(THREED(Sheet2:Sheet18!B1:B50),1)

--Tom