PDA

View Full Version : Search and highlight project help



malo1066
09-18-2012, 04:54 PM
This is my first post , im am just starting to learn about programming and at the moment i am taking little bits of program from the net to assist with a project i have , i am working on a master search file , which pulls excel worksheets within a folder from a certain area on our server into one file , that much ive managed to do, ive managed to find a code that lets me look for a string of text within those merged sheet , but i dont think its working correctly , it doesnt seem to highlight all search strings within each sheet, it also highlights the rows and i really only need the cell that contains the text highlighting ,

Dim sheetCount As Integer
Dim datatoFind
Sub Button1_Click()
Find_Data
End Sub
Private Sub Find_Data()
Dim counter As Integer
Dim currentSheet As Integer
Dim notFound As Boolean
Dim yesNo As String
notFound = True
On Error Resume Next
currentSheet = ActiveSheet.Index
datatoFind = StrConv(InputBox("Please enter the value to search for"), vbLowerCase)
If datatoFind = "" Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.Count
If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
For counter = 2 To sheetCount
Sheets(counter).Activate
Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If InStr(1, StrConv(ActiveCell.Value, vbLowerCase), datatoFind) Then
notFound = False
If HasMoreValues(counter) Then
yesNo = MsgBox("Do you want to continue search?", vbYesNo)
If yesNo = vbNo Then
Sheets(counter).Activate
Exit For
End If
Else
Sheets(counter).Activate
Exit For
End If
Sheets(counter).Activate
End If
Next counter
If notFound Then
MsgBox ("Value not found")
Sheets(currentSheet).Activate
End If
End Sub
Private Function HasMoreValues(ByVal sheetCounter As Integer) As Boolean
HasMoreValues = False
Dim str As String
Dim lastRow As Long
Dim lastCol As Long
Dim rRng As Excel.Range
For counter = sheetCounter + 2 To sheetCount
Sheets(counter).Activate
lastRow = ActiveCell.SpecialCells(xlLastCell).Row
lastCol = ActiveCell.SpecialCells(xlLastCell).Column
For vRow = 1 To 70
For vCol = 1 To lastCol
str = Sheets(counter).Cells(vRow, vCol).Text
If InStr(1, StrConv(str, vbLowerCase), datatoFind) Then
HasMoreValues = True
Exit For
End If
Next vCol
If HasMoreValues Then
Exit For
End If
Next vRow
If HasMoreValues Then
Sheets(sheetCounter).Activate
Exit For
End If
Next counter
'Color Row Yellow.
With Selection.EntireRow.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End Function


My next step in the project is to have it search through the merged workbooks for a cell conditionally formatted in a certain colour and pull them into one list on a separate sheet ....is this possible or a work around somehow ??

ive attached the master file with sensative info removed , hopefully those experts will see what im tryin to achieve .

Bob Phillips
09-19-2012, 12:45 AM
We can't test it, we don't have the files to look at.

malo1066
09-19-2012, 04:21 PM
not sure why i did attach it , unless im doing something wrong.i'll attach it again.

malo1066
09-19-2012, 04:23 PM
if you mean the files that pull through from the server , they are already saved in the master file that ive posted , that ive managed to get working, what i cant seem to get to work correctly is the search macro, it doesnt seam to search all the rows in each worksheet just some , and also highlights the row , rather than just the cell containing the matching text,
Sorry if im confusing you but as im only just starting to learn vba so not quite up to speed with terminology used