(VBA) Controlling Search Results using Data Validation

[ccooperr85]

Good Afternoon all,

I am definietly a "home taught" VBA/Excel user and my coding ability is more cut/paste/amend rather than develop.

At the moment I have found and amended an excellent piece of coding to suit my needs although I need to tweak the controls a little and cannot seem to get round it.

Issue:

On my attached example (ProjectDBTrial.xls) I have a number of sheets. Data containing all the relevant project data, Search which functions similarly to a MS Access Query (this is where the coding is) and the other relevant sheet is Portfolio_Dash which will end up being dashboard.

My aim is to allow the Search function to be controlled from the Portfolio_Dash Sheet. For example - if the user were on the Dashboard and he chose the project "Magnus". This would then select Magnus in the Search/Query, populate all the Magnus data in the search and then the Dashboard would take the information straight from the Seach Sheet.

At the moment the code (seen below) requires me to select the project on the search sheet drop down. Also a bit of a bug is that as soon as I click off the Search sheet and back on it resets.

If someone has the time to look at this, could you suggest a way to control the search function from the Portfolio_Dash sheet. The reason I cannot Make the Porfolio dash sheet the query is it has to have a very specific graphical template applied that will not work well with the function built in.

CODE:
Option Explicit
Private Sub Worksheet_Activate()
[c3] = "Type your search here."
[c3].Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim a As Range
Dim anchor As Range
Dim i As Long, c As Long

Const CELL_WITH_LOOKUP_VALUE = "c3"
Const RESULTS_RANGE = "a9:EE65536"
Const COLS_TO_DISPLAY = 122
Const KEY_COL = "b"
Const ROW_1 = 1
Const SEARCH_SHEET = "data"
Const SEARCH_RANGE = "A2:A65536"
If Intersect(Target, Range(CELL_WITH_LOOKUP_VALUE)) Is Nothing Then Exit Sub
[c3].Select


Me.Unprotect
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Range(RESULTS_RANGE).ClearContents

Set r = FindAll(Worksheets(SEARCH_SHEET).Range(SEARCH_RANGE), _
Range(CELL_WITH_LOOKUP_VALUE), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False _
)
If r Is Nothing Then GoTo ExitThisSub

Set anchor = Range(KEY_COL & ROW_1).Resize(, COLS_TO_DISPLAY)
For Each a In r.Areas
c = a.Count
i = Cells(Rows.Count, KEY_COL).End(xlUp).Row
anchor.Offset(i).Resize(c) = a.Resize(c, COLS_TO_DISPLAY).Value
Next


ExitThisSub:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Set r = Nothing
Set a = Nothing
Set anchor = Nothing

End Sub

Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FoundCells = FoundCell
FirstAddr = FoundCell.Address
Do
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function


Thanks for any help that can be provided (For some reason I cannot attach examples?)

 

[ccooperr85]

I will PM anyone who wants to see the example.

Thanks