Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Wow. This is interesting and slow. Any ideas?
I had some fun with this one.
I didn't know how to do the selector using an algorithm, so I used a geometric solution (Selector and DelBlanks.) Any ideas on how to speed this up? Sub GetUniques() Worksheets("Selection").Columns("A").Parse _ parseLine:="[xxxxx] [.xx]", _ Destination:=Worksheets("Selection").Range("D1") Range("D1", Range("D1").End(xlDown)).NumberFormat = "@" Worksheets("Selection").Range("D1").Value = "Portfolio" Worksheets("Selection").Range("E:E").Clear Range("D1", Range("D1").End(xlDown)).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=Range("F2").End(xlUp)(2), Unique:=True End Sub Public Sub Selector() Dim SelectorColumn As Range Dim nbCells As Integer Dim Master As Range Dim i As Integer Dim Minimum As Double Dim pstRange As Range Set Master = Range("G3", Range("N3").End(xlDown)) nbCells = Application.WorksheetFunction.Count(Master) Master.Copy Range("AK4").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False For i = 1 To nbCells Set SelectorColumn = Range("AK4:AK38") Set pstRange = Range("AG2").Offset(i, 0) SelectorColumn.Select Call DelBlanks Set SelectorColumn = Range("AK4:AK38") SelectorColumn.NumberFormat = "0.00000" Minimum = Application.WorksheetFunction.Min(SelectorColumn) pstRange = Minimum SelectorColumn.Find(Minimum).Clear Next i End Sub Sub DelBlanks() Dim rng As Range Dim Cel As Range Dim DelRng As Range Set DelRng = Nothing Set rng = ActiveSheet.Range("AK4", Range("AR4").End(xlDown)) For Each Cel In rng If Len(Trim(Cel.Value)) = 0 Then If DelRng Is Nothing Then Set DelRng = Cel Else Set DelRng = Union(DelRng, Cel) End If End If Next If Not DelRng Is Nothing Then DelRng.Delete Shift:=xlToLeft End If End Sub James |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Slow Excel Navigation with Up / Down Arrow and slow scrolling | Excel Discussion (Misc queries) | |||
interesting interpolation | Excel Programming | |||
another interesting thing... | Excel Worksheet Functions | |||
An interesting prospect. | Excel Programming | |||
Here's an interesting one... | Excel Programming |