List Extracted Rows Of Specified Data From Another Workbook

[swordswinger710]

Hello,

I have two workbooks. One is called the Extraction Sample, which is attached, and the second is the Sorted Results workbook.

The Extraction Sample workbook contains a master sheet with data in a chart, which gets updated periodically. The Sorted Results workbook contains a list of specific extracted results from the Extraction Sample workbook.

The formula I am trying to create for the Sorted Results workbook needs to do two things:

1. Extract only the rows from the master sheet in the Extraction Sample workbook which contain the word 'Thing' in column D.
2. List the extracted rows on the Sorted Results workbook in numerical order using the data from Column B.

What would be the best way for me to accomplish this? Thanks in advance for your wisdom.

[jaslake]

Hi swordswinger710

One approach is to Sort your Data on Column B then do a Custom Text Filter on Column D (Criteria1:="=*Thing*"). Copy the resulting Visible Cells to Sorted Results.

Another approach is to do the Custom Filter on Column D then copy the resulting Visible Cells to another Worksheet. Sort this "another" Worksheet on Column B and Copy the results to Sorted Results.

[mehmetcik]

Sub Macro3()

If ActiveWorkbook.Name <> "Extraction Sample.xlsm" Then Exit Sub
If ActiveSheet.Name <> "Sheet1" Then Exit Sub

    Range("A1:E" & Range("A1").End(xlDown).Row).Select

    Selection.AutoFilter
    
    ActiveSheet.Range("A1:E" & Range("A1").End(xlDown).Row).AutoFilter Field:=4, Criteria1:="=Thing", _
        Operator:=xlAnd
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)

    Sheets(ActiveSheet.Name).Name = "Sorted Results " & Replace(Date, "/", "-")
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1:E" & Range("A1").End(xlDown).Row).Select
    Selection.Columns.AutoFit
    ActiveWorkbook.Worksheets("Sorted Results " & Replace(Date, "/", "-")).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sorted Results " & Replace(Date, "/", "-")).Sort.SortFields.Add Key:=Range _
        ("B2:B" & Range("A1").End(xlDown).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sorted Results " & Replace(Date, "/", "-")).Sort
        .SetRange Range("A1:E" & Range("A1").End(xlDown).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Application.CutCopyMode = False
        Sheets("Sheet1").Select
    Selection.AutoFilter
    Range("A1").Select
End Sub

[swordswinger710]

Thank you jaslake, I wasn't sure how to code that, but mehmetcik got close, thank you. This works, but I need a few changes - I'm willing to use the button within the same workbook, but I'd like the button to be on the same sheet as the results. How do I change the code in order to do that? The sheet name for both the button and the list of results can be Sheet2. Thanks!

[jaslake]

Hi swordswinger710

Using mehmetcik's Code, it'll probably be something like this

Option Explicit

Sub Macro4()
    Dim rng As Range
    Dim ws As Worksheet, ws1 As Worksheet

    Set ws = Sheets("Sorted Results")
    Set ws1 = Sheets("Sheet1")
    Application.ScreenUpdating = False
    With ws1
        Set rng = .Range("A1:E" & .Range("A1").End(xlDown).Row)

        rng.AutoFilter Field:=4, Criteria1:="=Thing", _
                Operator:=xlAnd
        rng.Copy
    End With

    With ws
        .Range("A1").PasteSpecial
        .Columns.AutoFit
        Set rng = .Range("A1:E" & .Range("A1").End(xlDown).Row)
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range _
                ("B2:B" & .Range("A1").End(xlDown).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                xlSortNormal
        With ws.Sort
            .SetRange Range("A1:E" & Range("A1").End(xlDown).Row)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    ws1.AutoFilterMode = False
End Sub

This Code assumes Sheet Sorted Results exists and the Code is running from it.

[swordswinger710]

Thank you jasklake, that works swell with my sample workbook, but now when I'm trying to modify it to work with my actual workbook, I can't seem to shake a 'Subscript out of range' error whenever I hit the button. Nothing in the code is selected as the problematic part either - any idea what I'm doing wrong?

[jaslake]

Hi swordswinger710

I've not experienced this

Nothing in the code is selected as the problematic part

I'd suggest stepping through the Code (F8) to see where the Code faults...keep me posted...

Edit...the Code assumes that Sheet Sorted Results exists in the SAME Workbook. If it's in a DIFFERENT Workbook the Code will need modified

I have two workbooks. One is called the Extraction Sample, which is attached, and the second is the Sorted Results workbook

[swordswinger710]

Thank you jaslake! I was able to fix that issue - I was forgetting to change the name of Sheet1 to the actual name I needed. Silly mistake.

I apologize for my late responses, I'm only in the office a few times a week. Thank you so much for sticking with me here.

It's working quite nicely now, but I have another question - could you take a look at the attached sample workbook and see if the following can be done?

1. Display the results as shown on the Desired Thread Gauge List sheet instead of the way they are currently shown on the Current Thread Gauge List.

2. After clicking the button and the formula runs, have cell A1 selected for clarity purposes instead of all the cells that were just copied over.

Do let me know if you think this can be done, and thanks again for your help! It's greatly appreciated.

[jaslake]

Hi swordswinger710

See if this Code works for you

Option Explicit

Sub Macro4()
    Dim rng As Range
    Dim ws As Worksheet, ws1 As Worksheet

    Set ws = Sheets("Current Thread Gauge List")
    With ws
        .Cells.EntireColumn.Hidden = False
        .UsedRange.Offset(3, 0).Clear
    End With
    Set ws1 = Sheets("Current List")
    Application.ScreenUpdating = False
    With ws1
        Set rng = .Range("A4:T" & .Range("A4").End(xlDown).Row)

        rng.AutoFilter Field:=3, Criteria1:="=Thread Gauge", _
                Operator:=xlAnd
        rng.Copy
    End With

    With ws
        .Range("A4").PasteSpecial
        .Columns.AutoFit
        Set rng = .Range("A4:T" & .Range("A4").End(xlDown).Row)
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range _
                ("B4:B" & .Range("A4").End(xlDown).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                xlSortNormal
        With ws.Sort
            .SetRange Range("A4:T" & Range("A4").End(xlDown).Row)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Columns("C:J").EntireColumn.Hidden = True
        .Columns("L:L").EntireColumn.Hidden = True
        .Columns("N:T").EntireColumn.Hidden = True
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    ws1.AutoFilterMode = False
End Sub

[swordswinger710]

jaslake, I think that will almost do the trick for me, thank you so much! I did run into one little problem with the code though - for some reason I'm getting the first row of data on the Current List showing up on the Current Thread Gauge List all the time, even when it isn't a Thread Gauge.

And after hitting the button, all the updated cells remain selected - is there some way to select a different cell, for example A1, just to create one less step for the operator?

I've attached the workbook as we've got it so far. Would you be able to take one more look at it? And thank you so much again.

[jaslake]

Hi swordswinger710

Try the Code in the attached...

PS: I missed this

And after hitting the button, all the updated cells remain selected - is there some way to select a different cell, for example A1, just to create one less step for the operator?

Add the line of Code as indicated

Option Explicit

Sub Macro4()
    Dim rng As Range
    Dim ws As Worksheet, ws1 As Worksheet

    Set ws = Sheets("Current Thread Gauge List")
    With ws
        .Cells.EntireColumn.Hidden = False
        .UsedRange.Offset(2, 0).Clear
    End With
    Set ws1 = Sheets("Current List")
    Application.ScreenUpdating = False
    With ws1
        Set rng = .Range("A3:T" & .Range("A3").End(xlDown).Row)

        rng.AutoFilter Field:=3, Criteria1:="=Thread Gauge", _
                Operator:=xlAnd
        rng.Copy
    End With

    With ws
        .Range("A3").PasteSpecial
        .Columns.AutoFit
        Set rng = .Range("A4:T" & .Range("A4").End(xlDown).Row)
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range _
                ("B4:B" & .Range("A4").End(xlDown).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                xlSortNormal
        With ws.Sort
            .SetRange Range("A4:T" & Range("A4").End(xlDown).Row)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Columns("C:J").EntireColumn.Hidden = True
        .Columns("L:L").EntireColumn.Hidden = True
        .Columns("N:T").EntireColumn.Hidden = True
        .Range("A4").Select     '<---Add this line 
  End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    ws1.AutoFilterMode = False
End Sub

[swordswinger710]

Thank you yet again, now we're very close. I am having some final issues with the sorting though.

The fist gauge listed is always at the top no matter what the description is. Take a look at the attached workbook to see what I mean - 4-40 should be before .5-13, but then again, neither should .5-13 come before 10-32. The sorting I am trying to achieve is shown on the Desired Sorting sheet.

Do you think there's a way to fix that yet? Thanks again, by the way!

[jaslake]

Hi swordswinger710

Haven't forgotten about you...have the Sort surrounded...not quite there...get back to you...

[jaslake]

Hi swordswinger710

This Code in the attached appears to do as you require for the Custom Sort Routine...let me know of issues...

Option Explicit

Sub Copy_Me()
    Dim rng As Range
    Dim ws As Worksheet, ws1 As Worksheet

    Set ws = Sheets("Current Thread Gauge List")
    Application.ScreenUpdating = False
    With ws
        .Cells.EntireColumn.Hidden = False
        .UsedRange.Offset(2, 0).Clear
    End With
    Set ws1 = Sheets("Current List")
    Application.ScreenUpdating = False
    With ws1
        Set rng = .Range("A3:T" & .Range("A3").End(xlDown).Row)

        rng.AutoFilter Field:=3, Criteria1:="=Thread Gauge", _
                Operator:=xlAnd
        rng.Copy
    End With

    With ws
        .Range("A3").PasteSpecial
        .Columns.AutoFit
        .Columns("C:J").EntireColumn.Hidden = True
        .Columns("L:L").EntireColumn.Hidden = True
        .Columns("N:T").EntireColumn.Hidden = True
'        Set rng = .Range("A3:T" & .Range("A3").End(xlDown).Row)

        Call Sort_Me

        .Range("A1").Select
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    ws1.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub


Sub Sort_Me()
    Dim ws As Worksheet
    Dim rng As Range, cel As Range
    Dim iCustListNum As Long

    Set ws = Sheets("Current Thread Gauge List")
    With ws
        .Columns("AC:AF").Delete
        .Columns("AC:AE").NumberFormat = "@"
        .Columns("AF:AF").NumberFormat = "General"
        Set rng = .Range("B4:B" & .Range("A3").End(xlDown))
        rng.Copy Destination:=.Range("AC4")
        Set rng = .Range("AC4:AC" & .Range("A3").End(xlDown))
        For Each cel In rng
            On Error Resume Next
            cel.Offset(0, 1).Value = Split(cel, "-")(0)
            cel.Offset(0, 2).Value = Split(cel, "-")(1)
            cel.Offset(0, 3).FormulaR1C1 = "=CONCATENATE(RC[-2],""-"",RC[-1])"
            On Error GoTo 0
        Next cel
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key _
                :=Range("AD4:AD" & .Range("A3").End(xlDown)), SortOn:=xlSortOnValues, Order:=xlAscending, _
                DataOption:=xlSortTextAsNumbers
        With ws.Sort
            .SetRange Range("AD4:AE" & Range("A3").End(xlDown))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Set rng = .Range("AF4:AF" & .Range("A3").End(xlDown))

        iCustListNum = Application.CustomListCount + 1
        Application.AddCustomList rng.Value

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key _
                :=Range("B3:B" & .Range("A3").End(xlDown)), CustomOrder:= _
                Application.CustomListCount, DataOption:=xlSortTextAsNumbers
        With ActiveWorkbook.Worksheets("Current Thread Gauge List").Sort
            .SetRange Range("A3:M" & Range("A3").End(xlDown))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Application.DeleteCustomList Application.CustomListCount
        .Columns("AC:AF").Delete
    End With

End Sub

[swordswinger710]

Hello again! So sorry for the delay, life has been crazy and I haven't been in the office for quite some time.

That code looks much more like it, but I am having quite a bit of trouble whenever I click the 'Update List' button, and then try to save the workbook. I get a lovely 'Microsoft Excel has stopped working' message and the whole thing shuts down on me. Would you have any idea why? Thanks again!

[jaslake]

Hi swordswinger710

Is this happening on the File attached to Post #14 or another File? I don't have an issue on my platform with the Post #14 File.
If another File, attach the Offending File and I'll look at it.

[swordswinger710]

The problem seems to be with the code from Post 14. Even if I copy the code and paste it into another Excel workbook, upon clicking the button, I can no longer save without crashing the workbook. I am running Excel 2010 on Windows 7, but I'm not sure if that makes a difference?

[jaslake]

Does the File in Post #14 exhibit the same issue?

[jaslake]

I just ran the Code in Excel 2010 with no issue (using XP)...

Correction...upon SAVING the File in Excel 2010...Excel crashed...

[jaslake]

At the Bottom of the Sort_Me routine is this line of Code

 Application.DeleteCustomList Application.CustomListCount

Comment it out then run the Code...save the File...let me know.

[swordswinger710]

I finally got the chance to finish this up, and it works!

Thank you very much again!

[jaslake]

You're welcome...glad I could help. Thanks for the Rep.