VBA project to search, organize and return

[brooksc29]

Hello all,

I am working on a project that is a bit over my head.

I have a workbook with daily information created on separate tabs (worksheets). Each worksheet is titled by date.

The format on each daily worksheet has rows under a headline "Facts", rows under a headline "Rumors" and rows under a headline "Highlights"

In each row, starting in column F, will be Date (column F)/ Team (G)/ Name (H) /Notes (L)/ Source (T) (there are some merged cells for formatting purposes).

The VBA will be needed to run a search program on a separate tab called PLAYER LOOKUP. I want the user to choose a name from a data validated drop down box (cell E3), and the VBA will take the name in that box, find and return all entered data by the chosen name and return the data under the appropriate headline of "Facts", "Rumors", or "Highlights" (it should be able to tell where the data is being pulled from).

Can anyone help me get started with this? (at least!!??)

Please let me know what I can provide to make this easier!

Thank you so much!
C

 

[brooksc29]

Thanks Mumps!

There are a few bugs on the Player Lookup page. When a name is entered in the drop down box, the Highlights row section will jump up to cell R2. The Facts and Rumors tab does not do that.

Also, there is still an issue with clearing out previously entered names in the results if the user changes the name in the drop down box.

Finally, is there a way so that the data returned will be able be read in each cell? This was what I was worried about when reformatting Player Lookup. When the data is returned it is not easily read b/c of the size of the cell. Is there a way to format so that the text will wrap in the cell and the user can read it easily?

 

[mumps]

Click here for the file. I could not reproduce the problem with clearing out previously entered names.

 

[brooksc29]

Awesome! Thanks for the changes.

Last question (I hope!)... when I add in a new worksheet with the most recent date/update, the VBA has an error... it highlights
rumors = ws.Range("B:B").Find("RUMORS").Row
in the macro.

After I add a new worksheet, the macro clears the data and stops working.

Should I change anything in the macro?

 

[brooksc29]

I fixed it... just some merged cells on a new date entry!

Thank you so much for your help!!!!!!!

 

[brooksc29]

Mumps,

I'm still a little confused by this line in the macro

rumors = ws.Range("B:B").Find("RUMORS").Row

I had to add two sheets titled STATS19hit and STATS19pitch. These will have a macro to pull stats from the web.

After adding these sheets I got the error in the macro again highlighting the rumors line.

What is that line saying to do?

 

[mumps]

The macro loops through the sheets and excludes any sheets that are not date sheets. If you add more non date sheets the macro has to exclude them. Will you be adding any more sheets?

 

[brooksc29]

I added three sheets that are labeled STATS... with various endings based on what stats they are.

Other than future date sheets, no other sheets should be added moving forward.

I'll share my work with you here so you can see the recent changes.

 

[mumps]

Try:

Private Sub ComboBox1_Change()
    Application.ScreenUpdating = False
    Dim LastRow As Long, LastRow2 As Long, player As Range, rumors As Long, high As Long, ws As Worksheet
    With Range("D13:T1000")
        .ClearContents
        .Borders.LineStyle = xlNone
    End With
    For Each ws In Sheets
        If InStr(1, ws.Name, "-") Then
            LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            rumors = ws.Range("B:B").Find("RUMORS").Row
            high = ws.Range("B:B").Find("HIGHLIGHTS").Row
            Set player = ws.Range("E6:E" & rumors - 1).Find(ComboBox1.Value, LookIn:=xlValues, lookat:=xlPart)
            If Not player Is Nothing Then
                Intersect(ws.Rows(player.Row), ws.Range("B:B,D:D,E:E,F:F,G:G")).Copy Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
                LastRow2 = Range("D" & Rows.Count).End(xlUp).Row
                Rows("13:" & LastRow2).AutoFit
                Sheets("PLAYER LOOKUP").Sort.SortFields.Clear
                Sheets("PLAYER LOOKUP").Sort.SortFields.Add Key:=Range( _
                    "D13:D" & LastRow2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
                    xlSortNormal
                With Sheets("PLAYER LOOKUP").Sort
                    .SetRange Range("D12:H" & LastRow2)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
            Set player = ws.Range("E" & rumors + 2 & ":E" & high - 1).Find(ComboBox1.Value, LookIn:=xlValues, lookat:=xlPart)
            If Not player Is Nothing Then
                Intersect(ws.Rows(player.Row), ws.Range("B:B,D:D,E:E,F:F,G:G")).Copy Cells(Rows.Count, "J").End(xlUp).Offset(1, 0)
                LastRow2 = Range("J" & Rows.Count).End(xlUp).Row
                Rows("13:" & LastRow2).AutoFit
                Sheets("PLAYER LOOKUP").Sort.SortFields.Clear
                Sheets("PLAYER LOOKUP").Sort.SortFields.Add Key:=Range( _
                    "J13:J" & LastRow2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
                    xlSortNormal
                With Sheets("PLAYER LOOKUP").Sort
                    .SetRange Range("J12:N" & LastRow2)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
            Set player = ws.Range("E" & high + 2 & ":E" & LastRow).Find(ComboBox1.Value, LookIn:=xlValues, lookat:=xlPart)
            If Not player Is Nothing Then
                Intersect(ws.Rows(player.Row), ws.Range("B:B,D:D,E:E,F:F,G:G")).Copy Cells(Rows.Count, "P").End(xlUp).Offset(1, 0)
                LastRow2 = Range("P" & Rows.Count).End(xlUp).Row
                Rows("13:" & LastRow2).AutoFit
                Sheets("PLAYER LOOKUP").Sort.SortFields.Clear
                Sheets("PLAYER LOOKUP").Sort.SortFields.Add Key:=Range( _
                    "P13:P" & LastRow2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
                    xlSortNormal
                With Sheets("PLAYER LOOKUP").Sort
                    .SetRange Range("P12:T" & LastRow2)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

This macro checks if the sheet name contains the character "-" (hyphen). This will limit the search to the "Date" sheets only. If you add any more sheets, make sure the sheet name doesn't contain a hyphen.

 

[brooksc29]

Perfect!

Thank you for everything, Mumps!

 

[mumps]

My pleasure.