Extract Unique Sub-Heading Values List Starting with Numbers

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
How about
Code:
Sub GetUnique()
   Dim cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each cl In Range("A2", Range("A" & Rows.count).End(xlUp)).SpecialCells(xlConstants)
         If IsNumeric(Split(cl.Value, "-")(0)) Then .Item(cl.Value) = Empty
      Next cl
      Range("G3").Resize(.count).Value = Application.Transpose(.keys)
   End With
End Sub
 
Upvote 0
Thats great Sir It really works perfect. Sir Is it possible through the excel formulae. The reason is Sir after pasting the raw data the command would be required to run. Would be highly appreciated Sir.
 
Upvote 0
Formulae are not my strong suit, so cannot help, but hopefully another member will come along & supply one.
 
Upvote 0
Another way
Code:
Sub Unique_List()
  Range("H2").Formula = "=isnumber(left(A2,1)+0)"
  Range("A1", Range("A" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("H1:H2"), CopyToRange:=Range("G1"), Unique:=True
  Range("H2").ClearContents
End Sub
 
Upvote 0
How about
Code:
Sub GetUnique()
   Dim cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each cl In Range("A2", Range("A" & Rows.count).End(xlUp)).SpecialCells(xlConstants)
         If IsNumeric(Split(cl.Value, "-")(0)) Then .Item(cl.Value) = Empty
      Next cl
      Range("G3").Resize(.count).Value = Application.Transpose(.keys)
   End With
End Sub

Dear Fluff Sir,

Can you please modify your script to get the output in Sheet2 from Cell A1 when run the script.
 
Upvote 0
I had missed your request for formulas.

- If you are not using the same sheet each time, then surely running the code is no harder than inserting the formula and copying down.

- If you are using the same sheet each time and just putting new data into column A, then the code can be set to run automatically as follows.
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("A")) Is Nothing Then
    If Range("A" & Rows.Count).End(xlUp).Row > 1 Then
      Sheets("Sheet2").Columns("A").ClearContents
      Range("Z2").Formula = "=isnumber(left(A2,1)+0)"
      Range("A1", Range("A" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("Z1:Z2"), CopyToRange:=Sheets("Sheet2").Range("A1"), Unique:=True
      Range("Z2").ClearContents
    End If
  End If
End Sub

Every time new data is put into column A, the old column G list will be cleared and the new one created without you doing anything. :)


However, if you really do want a formula, try this in cell G2, copied down as far as you might ever need. If you think the column A data might ever extend beyond row 500 then you will need to increase that number in the formula. However, this is already a fairly resource-heavy formula and increasing that row number will make it more so.

=IFERROR(INDEX(A$2:A$500,AGGREGATE(15,6,(ROW(A$2:A$500)-ROW(A$2)+1)/ISNUMBER(LEFT(A$2:A$500,1)+0),ROWS(G$2:G2))),"")
 
Last edited:
Upvote 0
Not sure which suggestion you have settled on but in any case: You're welcome.
 
Upvote 0

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,632
Latest member
jladair

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