Extract some rows to a new sorted list?

Rixn

Board Regular
Joined
Jun 4, 2005
Messages
119
Office Version
  1. 2021
Platform
  1. Windows
I have a list with three columns:

aa 22
bb 44 1
cc 11
dd 33 1

and I want to create this list:

33 dd
44 bb

..that is, for only the rows with value 1 in the third column

Additional needs:
- Sorted by the second column (lowest on top)
- Switched column order
 
Thanks!
I'll start implementing it directly, but I do have information to the right of column BM in SheetSL. At this point only BN is poplutated. I could just move it, but I rather not lock my options as it will always force me to have the BM as the last column. If I have to add columns before the BM then the BM column will shift to BN or further right, which forces me to manually update my macro, or?

If you think it is better I can give you the real Excel file?
Is there a way to attach files with the message here?
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
If you think it is better I can give you the real Excel file?
Is there a way to attach files with the message here?
No, I'd rather not have the actual file and there is no way to attach files in the forum.
The screen shots you have posted and your explanations are pretty clear so we should get there shortly.

Just add these blue lines of code where shown and that should solve the problem of data to the right. We are only deleting it in a copy of the worksheet so no harm done. :)

Rich (BB code):
    'Delete the unwanted columns
    .Range(DelRng).Delete
    'Delete unwanted data to the right
    .Range("I1", .Cells(.Rows.Count, .Columns.Count)).ClearContents
    'Data of interest should now be in A9:Hxx so use that
    With .Range("A9", .Range("A" & Rows.Count).End(xlUp)).Resize(, 8)
 
Upvote 0
I get an error window:

Run error number '-2147417848 (80010108)'.:

Automation error

..at this row:

.Value = .Value
 
Upvote 0
As I understand we have two ways to approach the issue:

1) copy the sheet and then delete the unwanted columns
2) create a new sheet and then copy the wanted columns

Now we are doing the first alternative.
I have a lot of information, buttons and charts in that sheet, do you think it can cause extra work load to cause it to get stuck?
I had to force quit Excel one time, and it spend some time to execute some rows (not sure wich one - copying the shhet I assume).
Wouldn't it be faster to just work with less information?
 
Upvote 0
I have a lot of information, buttons and charts in that sheet, do you think it can cause extra work load to cause it to get stuck?
That could possibly be the problem.


Wouldn't it be faster to just work with less information?
Sounds like a good idea. :)
Here's a completely different approach. Probably harder to understand, but trying to just focus on the required data, as you suggested.

VBA Code:
Sub NewList_v2()
  Dim i As Long, j As Long, k As Long, Cols As Long, LastRow As Long, rws As Long
  Dim a As Variant, b As Variant, aRws As Variant, aCols As Variant
  
  'First actual data row in 'SL'
  Const FirstRow As Long = 10
  'Columns of Interest in 'SL', in the order we want
  'That is AB AA X A B C D BM
  Const ColsOfInterest As String = "28 27 24 1 2 3 4 65"
  'Value you want to filter on
  Const FilterVal As Long = 10
  
  'Make an array of column numbers for data area
  aCols = Split(ColsOfInterest)
  'Number of columns in result
  Cols = UBound(aCols)
  With Sheets("SheetSL")
    'Find last row in Index column
    LastRow = .Cells(.Rows.Count, CLng(aCols(Cols))).End(xlUp).Row
    'Make an array of row numbers for data area. ie 10, 11, 12, ..
    aRws = Evaluate("row(" & FirstRow & ":" & LastRow & ")")
    'Read all data rows, but only the cols of interest into an array
    a = Application.Index(.Columns("A:BM"), aRws, aCols)
  End With
  'Calculate number of data rows
  rws = LastRow - FirstRow + 1
  'Set up b as an array to receive results
  ReDim b(1 To rws, 1 To Cols)
  'Loop through rows and put ones that have correct Index value into array b
  For i = 1 To rws
    If a(i, 8) = FilterVal Then
      k = k + 1
      For j = 1 To Cols
        b(k, j) = a(i, j)
      Next j
    End If
  Next i
  'Put results into 'FF' sheet and sort
  With Sheets("SheetFF").Range("G4").Resize(k, Cols)
    .Value = b
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  End With
End Sub
 
Last edited:
Upvote 0
Wonderful!
It's pure magic!
It works like a charm!
I'm very grateful.

The only problem I have now is if I get too many of the filtered ones?
If I only want the 25 first rows to be shown I assume I just can limit the number of iteration of the loop?
..or is the sorting done after you have paste it in "SheetFF" so the code have to be rewritten a lot?
 
Upvote 0
Wonderful!
It's pure magic!
It works like a charm!
I'm very grateful.
Great, we got there in the end. :)



The only problem I have now is if I get too many of the filtered ones?
If I only want the 25 first rows to be shown I assume I just can limit the number of iteration of the loop?
..or is the sorting done after you have paste it in "SheetFF" so the code have to be rewritten a lot?
The sorting is done right at the end, but I believe the fix is simple.

1. Where all the 'Const' lines are near the start of the code, add a new one which says
Rich (BB code):
Const RowsToKeep As Long = 25
(Change the 25 if you want)


2. Add the blue line of code where shown below.
Rich (BB code):
  With Sheets("SheetFF").Range("G4").Resize(k, cols)
    .Value = b
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    .Offset(RowsToKeep).ClearContents
  End With
End Sub
 
Upvote 0
Yes, it worked!
..but I get some unwanted effects in SheetFF.

Some of the rows loses its formatting in column I, J, K, L and M. Only one entry in column H loses its formatting (row 20).
Somehow it is linked to the entries in column K since it only happens for the 12 occurances of one of those alternatives.

Furthermore I get the correct formatting for 12 rows below, starting with row 35 - but the pattern doesn't match the rows with the missing formatting.

Rows with wrong formatting: 4, 5, 9, 12, 19, 20, 21, 23, 24,26, 27, 28
Rows below that got the correct formatting that should not be changed: 34, 35, 36, 38, 41, 42, 44, 49, 50, 52, 54, 55

Really odd.
 
Upvote 0
Some of the rows loses its formatting in column I, J, K, L and M.
If you mean you are losing formatting that was already in those columns in SheetFF before the code was run then I would check that the formatting was really there in the first place. The only things my code does on SheetFF is ..
- write values (not formatting)
- sort
- remove values (not formatting)


If you mean formatting that was on cells in SheetSL is not carried across with the values to SheetFF, then that is true for all cells taken across. No formatting is intended to be transferred, values only.
 
Upvote 0
I'm not sure now. I re-formatted all the cells concerned and now it seem to work. :-)
But I get two minor unwanted effects:

1) If the limit is 25, and there are less than that I need the rest of the rows to the limit be empty, that is, over write empty if the cells had previous info.
2) If no hits occur, I get an error in the counting loop. I think when it is trying to populate a list, and the list end up with no entries then it generates an error.

I hope these two minors is easy to avoid, and that you would help me yet another time? I'm so grateful for all your help.
 
Upvote 0

Forum statistics

Threads
1,223,912
Messages
6,175,340
Members
452,638
Latest member
Oluwabukunmi

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