Extract X rows after using Auto filter

Y

YyY_PLM

New Member
Joined
Mar 20, 2022
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hi all,
I wrote a code that open log file, find specific data from rows and after that delete all blank & error cell and copy all filter data.
what I try to do is to copy 20 last rows after filter the log file .
problem: row number is randomly according to log file but its always be the last 20 rows
*I have few log files and in each log rows number are different

Rich (BB code): 
Sub RectangleRoundedCorners1_Click()
 Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim Y_Laser_factor As Range
    
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.log*),*log*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A1:B99999").Copy
        ThisWorkbook.Worksheets("Main_0").Range("A1").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        OpenBook.Close False
        
        'Y counts from Stage'
        
            Range("N2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(LEFT(MID(RC[-13],FIND("" Y :"", RC[-13])+4,LEN(RC[-13])),FIND(""("",MID(RC[-13],FIND("" Y :"",RC[-13])+4,LEN(RC[-13])))-1),"""")"
    Range("N2").Select
       Selection.AutoFill Destination:=Range("N2:N150000"), Type:=xlFillDefault
    Range("N2:N150000").Select
    
    'Y Laser Factor'
    
        Range("O2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(LEFT(MID(RC[-14],FIND(""Y laser :"",RC[-14])+9,LEN(RC[-14])),FIND("","",MID(RC[-14],FIND(""Y laser :"",RC[-14])+9,LEN(RC[-14])))-1),"""")"
    Range("O2").Select
    
    'filter without blank & #value! rows'
    
    Selection.AutoFill Destination:=Range("O2:O150000")
    Range("O2:O150000").Select
        Columns("N:N").Select
    Selection.AutoFilter
    ActiveSheet.Range("$N$1:$N$100162").AutoFilter Field:=1, Criteria1:="<>", Operator:=xlAnd, Criteria2:="<>#VALUE!"
    ActiveSheet.Range("$N$2:$O$100162").SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Worksheets("Y Laser Factor").Range("B4")
     Worksheets("Y Laser Factor").Range("O2").Formula = "=IFERROR(Average(D4:D23),"""")"
    End If
    Application.ScreenUpdating = True
    Worksheets(ActiveSheet.Index - 1).Select
    Range("O2").Select
    Selection.Copy
    Range("D24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


1649008099556.png
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
after your filter, add this lines, row1 and row20 are the rownumbers, you want.
VBA Code: 
    With Range("P2:P150000")                                   'in the (free?) P-column
          .FormulaR1C1 = "=IF(RC[-15]<>"""",ROW(),0)"           'rownumber if A-column isn't empty
          row20 = Evaluate("AGGREGATE(14,5," & .Address & ",20)")     'find the 20th-largest visible value in that column
          row1 = Evaluate("AGGREGATE(14,5," & .Address & ",1)")     'find the largest visible number in that column
          MsgBox Range(Range("A" & row20), Range("P" & row1)).Address     'this is the range with the 20 last visible rows
     End With
 
Upvote 0
BSALV said:
after your filter, add this lines, row1 and row20 are the rownumbers, you want.
VBA Code: 
    With Range("P2:P150000")                                   'in the (free?) P-column
          .FormulaR1C1 = "=IF(RC[-15]<>"""",ROW(),0)"           'rownumber if A-column isn't empty
          row20 = Evaluate("AGGREGATE(14,5," & .Address & ",20)")     'find the 20th-largest visible value in that column
          row1 = Evaluate("AGGREGATE(14,5," & .Address & ",1)")     'find the largest visible number in that column
          MsgBox Range(Range("A" & row20), Range("P" & row1)).Address     'this is the range with the 20 last visible rows
     End With
Click to expand...
tnx its work

how I can define the value that I received as a range ?( for example I get line 200 as the largest value i need to use the value in the cell to define range)

I try to used INDEX but its not work
 
Upvote 0
VBA Code: 
set c=  Range(Range("A" & row20), Range("P" & row1))
is the range that has within it 20 visible (=filtered) rows.
You can copy them to another sheet for example.
Index, ..., ? It's a little bit more difficult to say the last 20 visible rownumbers.
You want them ?
 
Upvote 0
BSALV said:
VBA Code: 
set c=  Range(Range("A" & row20), Range("P" & row1))
is the range that has within it 20 visible (=filtered) rows.
You can copy them to another sheet for example.
Index, ..., ? It's a little bit more difficult to say the last 20 visible rownumbers.
You want them ?
Click to expand...
I export the 20 visible rows, and I want define that value as a cell number
I want dynamic range change "$N$2:$O$100162" to value in cell "$N$42940: $N$42669"
$N$42940: $N$42669" is dynamic and change according R2:R21 cell value

1649105338715.png



Rich (BB code): 
 ActiveSheet.Range("$N$2:$O$100162").SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Worksheets("Y Laser Factor").Range("B4")

1649105989841.png
 
Upvote 0
you make it a little bit complicated, while excel has a nice texttocolumn-function to split your data.
Because you have only a image, it's difficult to predict where/how your data is splitted, so try this one
adjust the 3 and the 5 to the columns you need
Rich (BB code): 
    .FormulaR1C1 = "=if(ISNUMBER(RC[3])*ISNUMBER(RC[5]),row(),""~"")"     'the 3rd and the 5th column to the right are your wanted values (adjust to your situation)
if it's not working, can you send 5 good rows with the XL2BB-tool ?
VBA Code: 
Sub Test()

     Set sh = ThisWorkbook.Worksheets("Main_0")                 'the sheet, you're working with
     sh.Range("A1:B1").EntireColumn.ClearContents               'empty the columns A & B (perhaps more ???)


     FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.log*),*log*")
     If FileToOpen <> False Then
          Set OpenBook = Application.Workbooks.Open(FileToOpen)
          With OpenBook.Sheets(1).UsedRange                     'adjust to the real data
               myrows = .Rows.Count                             'real number of rows
               .Resize(, 2).Copy                                'copy A&B
          End With
          sh.Range("A1").PasteSpecial xlPasteValues
          Application.CutCopyMode = False
          OpenBook.Close False
     End If

     'myrows = 100000'for test

     With sh.Range("A1").Resize(myrows)
          .AutoFilter
          '.FormulaR1C1 = "=IF(RAND()<0.0002,""a   1111,1111:1111(1111,1111"",""aaa"")"     'for test
          '.Value = .Value                                       'for test

          .Offset(, 3).Value = .Value                           'copy A-column to D-column
          .Offset(, 3).Replace ":", ","                         'in D replace : by ,
          .Offset(, 3).Replace "(", ","                         'in D replace ( by ,
          Application.DisplayAlerts = False                     'no alerts
          .Offset(, 3).TextToColumns .Offset(, 4), xlDelimited, , , 0, 0, 1, 0, 0     'split D-column to E-column + next on the comma
          Application.DisplayAlerts = True                      'again alerts

          .Range("C1").Value = "MyC"                            'header for C
          With .Offset(1, 2).Resize(myrows - 1)
             .FormulaR1C1 = "=if(ISNUMBER(RC[3])*ISNUMBER(RC[5]),row(),""~"")"     'the 3rd and the 5th column to the right are your wanted values (adjust to your situation)
                 myarray = Evaluate(.Address)
               RowMin = WorksheetFunction.Min(myarray)          '1st rownumber with good data
               If RowMin = 0 Then MsgBox "no good data", vbCritical: Exit Sub     'not even one good row !!!
               s = "": ptr = 0
               For i = UBound(myarray) To 1 Step -1
                    If myarray(i, 1) <> "~" Then s = myarray(i, 1) & IIf(Len(s) > 0, vbLf, "") & s: ptr = ptr + 1
                    If ptr >= 20 Then Exit For
               Next
          End With

          .Resize(, 3).AutoFilter 3, "<>~"

          MsgBox "filtered range (sorry, display limited to 255 char)= " & vbLf & .Offset(1).Resize(myrows - 1, 5).SpecialCells(xlVisible).Address & vbLf & vbLf & "last x rownumbers : " & vbLf & s, , UCase("My Results")

     End With

End Sub
 
Upvote 0
BSALV said:
you make it a little bit complicated, while excel has a nice texttocolumn-function to split your data.
Because you have only a image, it's difficult to predict where/how your data is splitted, so try this one
adjust the 3 and the 5 to the columns you need
Rich (BB code): 
    .FormulaR1C1 = "=if(ISNUMBER(RC[3])*ISNUMBER(RC[5]),row(),""~"")"     'the 3rd and the 5th column to the right are your wanted values (adjust to your situation)
if it's not working, can you send 5 good rows with the XL2BB-tool ?
VBA Code: 
Sub Test()

     Set sh = ThisWorkbook.Worksheets("Main_0")                 'the sheet, you're working with
     sh.Range("A1:B1").EntireColumn.ClearContents               'empty the columns A & B (perhaps more ???)


     FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.log*),*log*")
     If FileToOpen <> False Then
          Set OpenBook = Application.Workbooks.Open(FileToOpen)
          With OpenBook.Sheets(1).UsedRange                     'adjust to the real data
               myrows = .Rows.Count                             'real number of rows
               .Resize(, 2).Copy                                'copy A&B
          End With
          sh.Range("A1").PasteSpecial xlPasteValues
          Application.CutCopyMode = False
          OpenBook.Close False
     End If

     'myrows = 100000'for test

     With sh.Range("A1").Resize(myrows)
          .AutoFilter
          '.FormulaR1C1 = "=IF(RAND()<0.0002,""a   1111,1111:1111(1111,1111"",""aaa"")"     'for test
          '.Value = .Value                                       'for test

          .Offset(, 3).Value = .Value                           'copy A-column to D-column
          .Offset(, 3).Replace ":", ","                         'in D replace : by ,
          .Offset(, 3).Replace "(", ","                         'in D replace ( by ,
          Application.DisplayAlerts = False                     'no alerts
          .Offset(, 3).TextToColumns .Offset(, 4), xlDelimited, , , 0, 0, 1, 0, 0     'split D-column to E-column + next on the comma
          Application.DisplayAlerts = True                      'again alerts

          .Range("C1").Value = "MyC"                            'header for C
          With .Offset(1, 2).Resize(myrows - 1)
             .FormulaR1C1 = "=if(ISNUMBER(RC[3])*ISNUMBER(RC[5]),row(),""~"")"     'the 3rd and the 5th column to the right are your wanted values (adjust to your situation)
                 myarray = Evaluate(.Address)
               RowMin = WorksheetFunction.Min(myarray)          '1st rownumber with good data
               If RowMin = 0 Then MsgBox "no good data", vbCritical: Exit Sub     'not even one good row !!!
               s = "": ptr = 0
               For i = UBound(myarray) To 1 Step -1
                    If myarray(i, 1) <> "~" Then s = myarray(i, 1) & IIf(Len(s) > 0, vbLf, "") & s: ptr = ptr + 1
                    If ptr >= 20 Then Exit For
               Next
          End With

          .Resize(, 3).AutoFilter 3, "<>~"

          MsgBox "filtered range (sorry, display limited to 255 char)= " & vbLf & .Offset(1).Resize(myrows - 1, 5).SpecialCells(xlVisible).Address & vbLf & vbLf & "last x rownumbers : " & vbLf & s, , UCase("My Results")

     End With

End Sub
Click to expand...

sorry for make it complicated,
I will try to make it easy
how I can define range as formula?
my goal is to copy value from row20 to row1
Rich (BB code): 
      ActiveSheet.Range("row1:row20").SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Worksheets("Y Laser Factor").Range("B4")
1649162529784.png
 
Upvote 0
@YyY_PLM
Another option:
after data is filtered:
VBA Code: 
Dim c As Range
Dim a As Long, n As Long
Set c = Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
a = c.Row: n = 1
        Do
          Set c = c.Offset(-1, 0)
          If c.EntireRow.Hidden = False Then n = n + 1
        Loop Until c.Row = 1 Or n = 20
    ActiveSheet.Range("N" & c.Row & ":" & "O" & a).SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Worksheets("Y Laser Factor").Range("B4")
 
Upvote 0
in #2 you had
MsgBox Range(Range("A" & row20), Range("P" & row1)).Address
so now
activesheet.range(Range("N" & row20), Range("O" & row1)).special.....
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Question
VBA not working in office 2010
Replies
7
Views
471
Jon Peltier
J
T
  • Solved
Block If without End If
2
Replies
13
Views
685
kevin9999
K
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
1K
Joe4
Joe4
Y
  • Question
Use auto filter for remove blank or #value! cell
Replies
3
Views
444
Peter_SSs
Peter_SSs
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
275
Coco1
C

Forum statistics

Threads
1,215,723
Messages
6,126,470
Members
449,315
Latest member
misterzim

Share this page

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