PDA

View Full Version : Search for multiple values



SeanBaird
06-17-2015, 02:04 AM
As it stands I have this code.
It performs perfectly except as it stands I can only search for one value. I realistically need it to search for multiple values
The values are all located in the same column I just cant figure out a scripting which works.


Sub Create_FHA_Table()
Dim Headers() As String: Headers = _
Split("FHA Ref,Engine Effect,Part No,Part Name,FM I.D,Failure Mode & Cause,FMCM,PTR,ETR", ",")
If Not WorksheetExists("FHA") Then Worksheets.Add().Name = "FHA"
Dim wsFHA As Worksheet: Set wsFHA = Sheets("FHA")
wsFHA.Move after:=Worksheets(Worksheets.Count)
wsFHA.Cells.Clear
Application.ScreenUpdating = False
With wsFHA
For i = 0 To UBound(Headers)
.Cells(2, i + 2) = Headers(i)
.Columns(i + 2).EntireColumn.AutoFit
Next i
.Cells(1, 2) = "FHA TABLE"
.Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).MergeCells = True
.Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).HorizontalAlignment = xlCenter
.Range(.Cells(1, 2), .Cells(2, UBound(Headers) + 2)).Font.Bold = True
End With
Dim RowCounter As Long: RowCounter = 3
Dim SearchTarget As String
SearchTarget = "9.1"
Dim SourceCell As Range, FirstAdr As String
If Worksheets.Count > 1 Then
For i = 1 To Worksheets.Count - 1
With Sheets(i)
Set SourceCell = .Columns(7).Find(SearchTarget, LookAt:=xlWhole)
If Not SourceCell Is Nothing Then
FirstAdr = SourceCell.Address
Do
wsFHA.Cells(RowCounter, 2).Value = SearchTarget
wsFHA.Cells(RowCounter, 3).Value = .Cells(SourceCell.Row, 6).Value
wsFHA.Cells(RowCounter, 4).Value = .Cells(3, 10).Value
wsFHA.Cells(RowCounter, 5).Value = .Cells(2, 10).Value
wsFHA.Cells(RowCounter, 6).Value = .Cells(SourceCell.Row, 2).Value
wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row, 3).Value
wsFHA.Cells(RowCounter, 8).Value = .Cells(SourceCell.Row, 14).Value
Set SourceCell = .Columns(7).FindNext(SourceCell)
RowCounter = RowCounter + 1
Loop While Not SourceCell Is Nothing And SourceCell.Address <> FirstAdr
End If
End With
Next i
End If
Application.ScreenUpdating = True
End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function

snb
06-17-2015, 02:49 AM
1. Never use merged cells: VBA can't cope with them
2. cells(1).resize(,5)=split("aa bb cc dd ee") suffices for the headers
3. wsFHA.Cells.Clear is 100% redundant (a new sheet doesn't contain anything)
4. if [iserr(isref(FHA!A1))] then : replaces the whole function 'worksheetexists'
5. if you are familiar with 'With ... End With' an objectvariable 'wsFHA' is 100% redundant
6. 'looking for' more than once = filtering ; use autofilter or advancedfilter

SeanBaird
06-17-2015, 04:10 AM
might have missed it in your reply snb but I don't really understand how to make the code search for multiple values. I understand there may be some redundant parts to the code but in its current state it works as desired.

snb
06-17-2015, 04:11 AM
Reread point 6.

SeanBaird
06-17-2015, 05:07 AM
Ah im not familiar with that command. Im new to VBA do you have any suggestions about how I could work it into my existing code ?