Free Microsoft Excel 2013 Quick Reference

# Find occurances of a character in string Results

## Find occurances of a character in a string

Which function should I use to find the number of times '/' occurs in a single cell. Will the function remain the same if I need to know how many times '/' occurs in an array?

Thanks,
Gaurav

## String Function

What is the string function to find the second occurence of a character in a
string?

Thanks

Brenda

## Position of a Character from Right

How to find out the position of a Character specified in a particular cell(string) which occurs more than once
Ex:
'The Demanded Commodity is not in stock' is in A1
the space " " appears six time
what is the position of fifith space " " ?

## Extract nth position of duplicate character in text string

Hi,

I'm trying to build a formula to find the position of a duplicate character in a text string for the nth occurance that I specify. Here is an example of the text : 34567-8-9-10-11-12-15-18-24-30-36-42-48-49-50-54-58-62-66-70-76-82-84-86-88-90-92-96-100-107-114 , I would like to find say the 10th dash and return its position within the string.

thank you if you are able to help

## How find character position # in string from right end? Or how get range row num

I have a macro where I need to get the row number from a
range (like the 11 in "\$G\$11") becausen I will compare it
with another row number later (if rownum1 < rownum2
then ...)
The way I do it now is:
1 get the position of the first '\$' from the right (I made
a function like InStr, except it looks from the right end
of string, not the left end)
2 get the right part of the string for as many chars as
(total length of string - position of first '\$' from left)

ie for "\$G\$11":
1 position of first '\$' from right is 3
2 length of string-position=row number length. 5-3=2, so
get "11"
Then I can compare "11" with another row number (like 6 or
whatever).
I am wondering if there is an easier way to do this, or is
there a built-in command for this? I wanted to use InStr,
but InStr looks for the first occurence of a string from
the left, not right. I can't use right(string1,2) either
because the row number might be "1" or "326" or "4355"
or "65029", where the number of digits change.
Any ideas?
Thanks again.

## Sum numbers left of a character from within a string

Please see attached sheet. I can count the number of occurances that a Variable is found in a string but need a formula that will find that variable and sum up only the first set of numbers to the left.

Thanks

## Find position of all locations of given character in a string

Friends,

I want to write a formula to find position of all locations of a given character in a string/cell. Find and Search functions give the first occurence of such location.

Eg: If I have "Apple" in A1, I want my formula result as 2,3 if my search string is 'p". FIND("p",A1) will give 1. Search("p",A1) also gives 1.

Can anyone help.

Thanks

## COUNTIF to find occurences of duplicate strings within strings

Hi Guys,

Really struggling with a query in excel.

I am trying to use SUMIF to count the occurrences of a 3 character alphanumeric entry of text in a series of cells.

I have a simple version which works however it counts the cells which have that occurrence in not the amount of times that string occurs.

I know it would be better to rewrite the spreadsheet but that is not possible due to certain limitations.

In this example the text in the field is

"UH X4 - 314657 R01 22/02/09 - 314972 R09 03/05/09 - 315627 R01 09/06/09 - 315932 R09 25/06/09"

This is telling me

UH = Unacceptable history
X4 = 4 Jobs have been done to this job
xxxxxx = the job number
XYY = The person working on it
Date, the date the job was completed

I have about 30 other rows similar to this within the column and I need to count all the times R01 and R02 occur in the whole column, not the ammount of cells that occurrence is in.

This is what I am using to cound that column.

=SUM(COUNTIF(\$N\$6:\$N\$1000,"*R01*"))

This calculates how many Cells R01 appears in however as you can see above R01 appears twice, I need it to count that as 2 not 1.

Also if there is some way I can extract the dates from this field and calculate a mean average between the dates and flag up dates that are 3 weeks apart or less that would be great.

Any help would be appreciated, I'm sorry for rambling on but I'm really stuck on this one.

Thanks
Ross

## Extact next word after FIND of another word within string

Hello,

I have a sheet with columns of data, 2 adjacent columns have data, example below:

Column A Column B Column C
Base Model Model Description
Avalon Toyota Avalon XLS Sedan
Avalon Toyota Avalon XL Sedan
Camry Toyota Camry Hybrid Coupe
Camry Toyota Camry XLE Wagon

What I'd like to do is a find, searching the text string in Column B, for the occurence of the contents in column A, and then return the NEXT word after the found word in column C. I suspect I many need to use a vba function, but lack the skills. Currently I'm using a MID an LEN find formula (below) in Column C, but it's limited to a character count, and I only want to return the next whole word.

=MID(B2,FIND(A2,B2)+0,5)

This returns the following:
Column A Column B Column C
Avalon Toyota Corp. Avalon XLS Sedan XLS
Avalon Toyota Avalon XL Sedan XL S
Camry Toyota Co. Camry Hybrid Coupe HYBR
Camry Toyota Motors Camry XE Wagon XE W

What I want to return is just the trim level: Hybrid; XLS, XL or XE for example. As you can see, when using the character count, it may also extract into the body style; such as the W in wagon, etc. I've tried variations using RIGHT also, and still seems to be limited by the character count.

Eventually, if it works, in column D I'll concatenate the Column A and D together to return Avalon XLS, etc.

I know there are ways to filter, sort, vlookup, etc, based on all the model types, but those solutions won't work, because the data I'm using isn't toyota cars; not trim levels, and I have a sheet which is 77,000 rows long, by 90 columns wide, and there are over 18,000 unique/distinct values in column B.

I've also considered converting text to columns, which fails because sometimes the 'trim' level is the second word, sometime it's the 10th word; but it ALWAYS follows the model (which is listed solo in column A).

Thanks,

Andrew

## Counting No of character in a string

Hi,

I have a data for ex a;b;c;d in a cell if i find ";" excel formula should
display result as 3 because no of occurence of ";" in a cell is 3.

I need a excel formula to do this help me out.

## Find last occurance of character in text string

I am working with a spreadsheet that contains product descriptions. The
descriptions have varying lengths, but all have a "suffix" code of some type
at the end of the description that I would like to eliminate. Here is an
example of the data I'm working with:

10 OZ GREEN BEANS Rfg
12 OZ CHILI WITH MEAT AND BEANS Grocery

In this example, I need to eliminate the " Rfg" in line 1, and the "
Grocery" text in line 2. My hunch is that I need to use a combination of
"FIND" and "LEFT" to basically find the last occurance of "space", then bring
back the leftmost "n" characters based on the position of that last "space".
Can someone help??

## Count occurences based on first X characters in string of numbers

Hi all,

I've hit a snag and cannot figure out a workaround.
I am trying to search row by row for any number starting with 425 (the numbers will range from 4250 to 4259) and report a binary result.

say the data looked like this:
A B C D (the columns go out to IC,the rows to 24875!!)
Row1: 0385 / Jack / 4259 / Phil

i have been trying =if(countif(a1:e1),"425?"),1,0), however, it doesnt seem to recognize the wildcard. I have tried using numbers as text and numbers and i get the same result. since the dataset is so large, im trying to automate whatever i can without having to use a nested if(or( to find all the data semi-automatically. any thoughts?
thanks,
pete

## Program to open and append all files in a given directory......not work at ~ 92k rows

Below is some code. Its supposed to read in all the files in a given directory and then append them all together. But at the 92K rows area i try to add another file and for some reason the "last_row2" variable goes to the value of "2" and I can not figure out why?

note: i could nto paste all the code as there is a 10000 character limitation

```Option Base 1
Public bOK As Boolean, baderror As Boolean
Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As
String) As Long

'Public Const Sheet_Collection_Sheet = "Collection Sheet"

'***********************************************************************
'***********************************************************************
'     Determines the row num of the last nonempty cell begining at x,y
'              Better function........faster!!!!!!!!!1
'***********************************************************************
'***********************************************************************
Function lastrow(iRow As Integer, iCol As Integer, sWkb As String, sWks As String, search_direction As String) As Long
If search_direction = "down" Then
lastrow = Workbooks(sWkb).Sheets(sWks).Cells(iRow, iCol).End(xlDown).Row
Else:  lastrow = Workbooks(sWkb).Sheets(sWks).Cells(Rows.Count, iCol).End(xlUp).Row
End If
End Function
'***********************************************************************
'***********************************************************************
'     Returns the col num of the right most col begining at x,y
'***********************************************************************
'***********************************************************************
Function ColNumRt(iRow As Long, iCol As Long, sWkb As String, sWks As String, search_direction As String) As Long
If search_direction = "right" Then
ColNumRt = Workbooks(sWkb).Sheets(sWks).Cells(iRow, iCol).End(xlToRight).Column
Else: ColNumRt = Workbooks(sWkb).Sheets(sWks).Cells(iRow, iCol).End(xlToLeft).Column
End If
End Function
'***********************************************************************
'***********************************************************************
'                     Determines if an array is empty
'***********************************************************************
'***********************************************************************
Function IsArrayEmpty(a As Variant) As Boolean
IsArrayEmpty = Len(Join(a, "")) = 0
End Function
'***********************************************************************
'***********************************************************************
'     Returns the character equivalent of a col num
'***********************************************************************
'***********************************************************************
Function alphacol(numcol As Long)
If numcol > 0 And numcol < 257 Then
If numcol > 26 Then
colchar = Chr(64 + Int((numcol - 1) / 26))
colchar = colchar & Chr(65 + ((numcol - 1) Mod 26))
Else: colchar = Chr(65 + ((numcol - 1) Mod 26))
End If
End If
alphacol = colchar
End Function
'***********************************************************************
'***********************************************************************
'   Identifies the row or col  where the "NEXT" occurance occurs of
'   a given string.
'Modified from   http://www.vbaexpress.com/kb/getarticle.php?kb_id=235
'the modified version finds the EXACT string and nothing else
'***********************************************************************
'***********************************************************************
Function Find_next_occurance(Rng As Range, TextToFind As String, rowcol As String) As Long

Dim cl As Range, x As Long
Find_next_occurance = 0

For Each cl In Rng
If cl.Value = TextToFind Then
'If InStr(1, cl, TextToFind) > 0 Then
If rowcol = "row" Then
Find_next_occurance = cl.Row
ElseIf rowcol = "col" Then
Find_next_occurance = cl.Column
End If
GoTo foundit
End If
Next cl

foundit:

End Function

'***********************************************************************
'***********************************************************************
'     Determines the row num of the last nonempty cell begining at x,y
'              Better function........faster!!!!!!!!!1
'***********************************************************************
'***********************************************************************
Sub Main_Combine_Files_Program()

Dim file_array() As Variant
Dim Path1 As String
Dim Tempfilename As String
Dim tempsheetname As String

Dim CopyFilename As String
Dim x As Long
Dim last_col1 As Long
Dim last_row1 As Long
Dim last_row2 As Long
Dim filename_combinemacro As String

Dim name_error As Boolean
Dim Sheet_Collection_Sheet As String

'Do not display alerts in case there was a problem
On Error Resume Next

filename_combinemacro = ThisWorkbook.Name
Workbooks(filename_combinemacro).Activate

get_name_of_sheet filename_combinemacro, Sheet_Collection_Sheet, name_error

'MsgBox (" nae is   " & Sheet_Collection_Sheet)

If name_error Then
MsgBox ("Check the name of the sheet on the main page.  It appears you have input an invalid result.  Program will
now end.")
GoTo endsub_combinemacro
End If

get_list_of_files_and_path file_array, Path1

'For Z = 1 To UBound(file_array())
'MsgBox (Z & "   " & file_array(Z))
'Next
'
'
'MsgBox ("stp hereeeeeeeeeeeeeeeeeeeeee")

done = False
x = 1

If UBound(file_array()) > 0 Then

Tempfilename = ActiveWorkbook.Name
tempsheetname = ActiveSheet.Name

With Workbooks(Tempfilename).Worksheets(tempsheetname).Columns("A")
.ColumnWidth = .ColumnWidth * 2
End With

Do While Not (done)
Workbooks.Open FileName:=Path1 & file_array(x)
CopyFilename = ActiveWorkbook.Name
MsgBox ("x is " & x)
MsgBox ("file array x is    " & file_array(x))

'If user wanted first or last sheet in file then this is where you do that.
'if user input an actual value then this value is already in
'the Sheet_Collection_Sheet variable
If Sheet_Collection_Sheet = "sheetfirstsheet" Then
Sheet_Collection_Sheet = Workbooks(CopyFilename).Worksheets(1).Name
ElseIf Sheet_Collection_Sheet = "sheetlastsheet" Then
Sheet_Collection_Sheet = Workbooks(CopyFilename).Worksheets(Worksheets.Count).Name
End If

'MsgBox (" sheet name is    " & Sheet_Collection_Sheet)

last_row1 = lastrow(1, 1, CopyFilename, Sheet_Collection_Sheet, "up")
MsgBox ("lastrow   " & last_row1 & "   for   " & CopyFilename)

last_col1 = ColNumRt(1, 1, CopyFilename, Sheet_Collection_Sheet, "right")

'copy data from file. if its the first file then copy header if not first file then copy data only
If x = 1 Then
MsgBox ("in copy 1")
Workbooks(CopyFilename).Worksheets(Sheet_Collection_Sheet).Range("A1:" & alphacol(last_col1) &
last_row1).Copy
Else
MsgBox ("in copy NOT 1")
Workbooks(CopyFilename).Worksheets(Sheet_Collection_Sheet).Range("A2:" & alphacol(last_col1) &
last_row1).Copy
End If

'Workbooks(CopyFilename).Worksheets(Sheet_Collection_Sheet).Range("A2:" & last_col1 & last_row1).Copy
'MsgBox ("stop here")
If x = 1 Then
MsgBox ("x is qual to 111111111111111111111111111111111")
last_row2 = 1
Else

'*****here is where my error occurs.......after about 92323 rows of data i try to add another file of 5k rows and
' for some reason teh last_row2=variable all of a sudden goes to the value of "2"

last_row2 = lastrow(1, 1, Tempfilename, tempsheetname, "up") + 1
MsgBox ("lastrow2 is   " & last_row2)
MsgBox ("lastrow2 anotehr way  " &
Workbooks(Tempfilename).Worksheets(tempsheetname).Range("A" & Rows.Count).End(xlUp).Row)
MsgBox ("file is " & Tempfilename & "    name sheet is    " & tempsheetname)
End If

'Workbooks(Tempfilename).Activate
'MsgBox ("see")
'MsgBox ("just before paste")
Workbooks(Tempfilename).Worksheets(tempsheetname).Range("A" & last_row2).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

MsgBox ("just after paste...............")
'xlPasteAll
'xlPasteValues
'xlPasteValuesAndNumberFormats

Workbooks(CopyFilename).Close

'Test to see if you need to jump outof the loop
If x < UBound(file_array()) Then
MsgBox ("less than ubound")
x = x + 1
Else: done = True
MsgBox ("greater than ubound")
End If
Loop

Else:  MsgBox ("Array is empty....")

End If
endsub_combinemacro:
End Sub```

## Find last occurance of character in text string

I am working with a spreadsheet that contains product descriptions. The
descriptions have varying lengths, but all have a "suffix" code of some type
at the end of the description that I would like to eliminate. Here is an
example of the data I'm working with:

10 OZ GREEN BEANS Rfg
12 OZ CHILI WITH MEAT AND BEANS Grocery

In this example, I need to eliminate the " Rfg" in line 1, and the "
Grocery" text in line 2. My hunch is that I need to use a combination of
"FIND" and "LEFT" to basically find the last occurance of "space", then bring
back the leftmost "n" characters based on the position of that last "space".
Can someone help??

## Contents Of A String

Is there any way of finding how often a particular character occurs in a particular string? I know how to find out whether it occurs at all and if so how far into it, but not how often.

## Always loops in same sheet

```
VB:
CommandButton1_Click()
'Procedure level variables
Dim lCount As Long
Dim lOccur As Long
Dim rCell As Range
Dim rCell2 As Range
Dim rCell3 As Range
Dim bFound As Boolean
Dim sestej As Long

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'do something

'Dim strfind4 As String
'At least one value, from ComboBox1 must be chosen
If strFind1 & strFind2 & strFind3 = vbNullString Then
MsgBox "Izbran ni bil noben kriterij", vbCritical
Exit Sub 'Go no further
ElseIf strFind1 = vbNullString Then
MsgBox "A value from " & Label1.Caption _
& " must be chosen", vbCritical
Exit Sub 'Go no further
End If

'Clear any old entries
On Error Resume Next
ListBox1.Clear
On Error Goto 0

'If String variable are empty pass the wildcard character
If strFind2 = vbNullString Then strFind2 = "*"
If strFind3 = vbNullString Then strFind3 = "*"

'Set range variable to first cell in table.
Set rCell = rRange.Cells(1, 1)
'Pass the number of times strFind1 occurs
lOccur = WorksheetFunction.CountIf(rRange.Columns(1), strFind1)

'Loop only as many times as strFind1 occurs
For lCount = 1 To lOccur
'Set the range variable to the found cell. This is then also _
used To start the Next Find from (After:=rCell)
Set rCell = rRange.Columns(1).Find(What:=strFind1, After:=rCell, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Check each find to see if strFind2 and strFind3 occur _
on the same row.
If rCell(1, 2) Like strFind2 And rCell(1, 4) Like strFind3 Then
bFound = True 'Used to not show message box for no value found.
'Add the address of the found cell and the cell on the _
same row but 2 columns To the right.

ListBox1.List(ListBox1.ListCount - 1, 1) = rCell.Offset(0, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 2) = rCell.Offset(0, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 3) = rCell.Offset(0, 3).Value
ListBox1.List(ListBox1.ListCount - 1, 4) = rCell.Offset(0, 4).Value

ListBox1.ControlTipText = "Dvoklikni na naslov celice in ne na besedilo (naslov :\$A\$2:\$A\$2)"
End If

If rCell(1, 2) Like strFind2 And rCell(1, 4) Like strFind3 Then
sestej = WorksheetFunction.Sum(rCell(1, 3)) + sestej
TextBox1.Text = sestej
End If
Next lCount

If bFound = False Then 'No match
MsgBox "Zapis s tem kriterijem ne obstaja", vbOKOnly
End If
Next ws
End Sub

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

```
where should i write the code for this form, to loop through all sheets in workbook find data and display them in listbox

I cant manage to do that, it always loops as many times as there are sheets in workbook but doesnt find records from other sheet

ex: 21 saban -this is in sheet1
21 drek -this is in sheet2

then i get results in listbox twice, but from the same sheet
in listbox is:
21 saban
21 saban

## CSV File end of line (Unix) character?

Hi all, In summary, I am using the code below to read in each line of the attached CSV file. When opened in Notepad or Textpad or Excel there are 1,139 rows/lines. So you would think there are 1,139 carraige returns.

My code is supposed to read each line of the csv file using Line Input. Lline input will only read a string up to but excluding the paragraph marker - from help file:

The Line Input # statement reads from a file one character at a time until it encounters a carriage return (Chr(13)) or carriage return–linefeed (Chr(13) + Chr(10)) sequence. Carriage return–linefeed sequences are skipped rather than appended to the character string.
```
VB:
test_csv()

Dim my_string As String
Dim iloop As Integer

Open "c:test.csv" For Input As #1
While Not EOF(1)
Line Input #1, my_string
Wend

MsgBox ("length of line: " & Len(my_string) & Chr(13) & "number of carraige returns: " & InStr(my_string, Chr(13)))

Close #1

End Sub

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

```
However, the code loops only once... the eof marker is reached on the first line input statement and the ENTIRE file is read into one string. Presumably because it is can not find any chr(13) 's. Testing this proves decisive - the msg box shows zero occurances of chr(13).

This CSV file was generated as part of another process on a Linux machine (I wanted to analyse it in Excel).

Whats wrecking my head is I dont know what the end of line marker is for Linux.... so I cant even do a search and replace for it to make sure that Line Input will work ok....

I have noticed that if I open the csv file in excel and re-save it immediately even without any text changes, the code will work fine next time around, reporting 1139 carraige returns. So it seems excel recognises a Linux carraige return, but Line Input does not.

Any idea's greatly appreciated.

Ger

## Using Regular Expressions to perform Find and Replace of whole words

Hi,

I use this board extensively and I've managed to complete something I've been working on for a while, and I wanted to give something back as a way of saying thanks.

The piece of work gets user input from one userform field and sends the output to another field. During the process it replaces known "words" with known "abbreviations". It's part of a tool to create output for SMS messages that have approved abbreviations (which managers have agreed too).

This first bit of code requires a textfield called txtIssue to exist on a userform called frmSendSMS. This subroutine is triggered everytime the field changes i.e. each time a character is entered or deleted by the user.

Code:
```Private Sub txtIssue_Change()
Dim RawText As String
RawText = frmSendSMS.txtIssue.Value

'Copy RawText to "Issue" (sheet "SMS" cell b5)
Worksheets("SMS").range("b5").Value = RawText

'Run TextFilter to process Glossary
Call TextFilter(RawText)

'Copy Filtered RawText to "Issue (Filtered)" (sheet "SMS" cell b6)
Worksheets("SMS").range("b6").Value = RawText

'View SMS
Call viewSMS
End Sub```
So each time the txtIssue subroutine, it in turn runs the TextFiler subroutine. When it does this is passes the content of the txtIssue field to the TextFilter as a variable called RawText

The TextFilter then uses a regular expression to do pattern matching. It does this by refering to a worksheet called Glossary. The layout of the Glossary sheet is shown below. It is simply three columns; one has the keyword, the second the abbreviation for the keyword and a description (optional - not used by the subroutine).

TextFilter does this;

1. read txtIssue input as RawText
2. create a regular expression object
3. modify the object to change default matching from first occurrence, to check all occurrences.
4. modify the object to switch off case sensitivity
5. read first row of Glossary sheet
6. Store first value in column "a" as Term
7. Store first value in column "b" as Abbr
8. then use regular expression "b" & Term & "b" to locate all occurances of Term in the string RawText and replace it with Abbr
9. Send the modified RawText which is returned back to the txtIssue subroutine to cell Worksheets("SMS").range("b6").Value
10. then restart loop on the next row down in the Glossary

Code:
```Private Sub TextFilter(ByRef RawText As Variant)
'Create a regular expression object
Set regEx = CreateObject("VBScript.RegExp")
'Set patterning matching to check all occurances
regEx.Global = True
'Set to be case insensitive
regEx.IgnoreCase = True

'Loop through rows on the "Glossary" sheet
Do
TermLoc = "a" & row
AbbrLoc = "b" & row
row = row + 1
Term = StrConv(Worksheets("Glossary").range(TermLoc).Value, VbStrConv.vbLowerCase)
Abbr = StrConv(Worksheets("Glossary").range(AbbrLoc).Value, VbStrConv.vbLowerCase)

'Replace all occurances of "Term" with the "Abbreviation"
'and ingore all partial matches
regEx.Pattern = "b" & Term & "b"
RawText = regEx.Replace(RawText, Abbr)
Loop Until Term = ""
End Sub```
This is how the Glossary sheet is laid out.

Code:
```	A	B	C

1	Term	Abbr.	Description

2	error	err	what the term error means can be written here

3	message	msg	what the term error means can be written here```
I hope this is a welcome addition to the knowledge pool.

Regards
Michael Gruber

## SUMPRODUCT doesn't work with wildcard in Excel 2003

Hi ... I'm a newbie and I hope you can help me out. I've spent several hours trying to find the correct formula to help me analyze a survey. in Excel 2003.

The survey has a series of questions ... 5-1., 5-2., 5-3., etc. and each response is a particular consistent string of characters. I want to total all the different replies to each question and have arranged the questions in column A and the answers in B. I chose the following command:
=SUMPRODUCT((A1:A8="5-1.*")*(B1:B8="*Lennon*"))

I believe the SUMPRODUCT should work. It works fine if the entire question string is entered between quotes and if the corresponding longer answer e.g. "John Lennon played with the Beatles" is also used. I want to use wild cards (with only the question number and a unique word in the answer) to make it easier.

I'd appreciate any suggestions as to how to get the wild cards working and if there is a better conditional process other than SUMPRODUCT. I am willing to try it out.

Thanks in advance. I trust the image (HTML code) displays properly below.

******** ******************** src="*********>

## Searching a workbook

Hi,

I've a large series of workbooks which contain data covering multiple sheets, sometimes over 20 sheets.

I have a code which I obtined from somewhere online (can't remember where) I've modified it a little to fit into my spreadhsheet. The problem is that it won't search beyond a certain point in the document for some reason. I'm not sure if this is a fault in the code, or some other limiting factor. Your help would be much appreciated.

The code I'm using for the search utility is shown below.

Ideally I would be able to just display the data I want when I open the page, but since all the workbooks are different in format and content, it looks like this may be a more manual operation.

Code:
```'In the Search sheet
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.Run "SearchWord.xla!FindAll", Target.Text, "False"
Cells(1, 2).Select
End If
End Sub

Option Explicit
On Error Resume Next
Application.CommandBars("Tools").Controls("Search &word").Delete
On Error GoTo 0
.Caption = "Search &word"
.Tag = "Search word"
.OnAction = "'" & ThisWorkbook.Name & "'!Search.DoFindAll"
End With
End Sub

On Error Resume Next
Application.CommandBars("Tools").Controls("Search &word").Delete
End Sub

'In a module of the Add-In
Option Compare Text
Option Explicit

Public Sub DoFindAll()
FindAll "", "True"
End Sub

Public Sub FindAll(Search As String, Reset As Boolean)

Dim WB              As Workbook
Dim WS              As Worksheet
Dim Cell            As Range
Dim Prompt          As String
Dim Title           As String
Dim FindCell()      As String
Dim FindSheet()     As String
Dim FindWorkBook()  As String
Dim FindPath()      As String
Dim FindText()      As String
Dim Counter         As Long
Dim Path            As String

If Search = "" Then
Prompt = "What do you want to search for in the worbook: " & _
vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = InputBox(Prompt, Title, "Enter search term")
If Search = "" Then
GoTo Cancelled
End If
End If

Application.EnableEvents = False
Application.ScreenUpdating = False

On Error GoTo Cancelled

Set WB = ActiveWorkbook
For Each WS In WB.Worksheets
If WS.Name  "SearchWord" Then
'Search whole sheet
'With WB.Sheets(WS.Name).Cells
'***********************************
'Alternative to search single column
With WB.Sheets(WS.Name).Range("B:B")
'***********************************
Set Cell = .Find(What:=Search, LookIn:=xlValues, LookAt:=xlPart, _
MatchCase:=False, SearchOrder:=xlByColumns)
If Not Cell Is Nothing Then
Do
Counter = Counter + 1
ReDim Preserve FindCell(1 To Counter)
ReDim Preserve FindSheet(1 To Counter)
ReDim Preserve FindWorkBook(1 To Counter)
ReDim Preserve FindPath(1 To Counter)
ReDim Preserve FindText(1 To Counter)
FindText(Counter) = Cell.Text
FindSheet(Counter) = WS.Name
FindWorkBook(Counter) = WB.Name
FindPath(Counter) = WB.FullName
Set Cell = .FindNext(Cell)
End If
End With
End If
Next

'If no result found, reset properties and exit sub
If Counter = 0 Then
MsgBox Search & " was not found.", vbInformation, "Zero Results For Search"
'Clear old results if required
'Range("A3", ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
'**********************************
GoTo Cancelled
End If

'Add SearchWord sheet if not present
On Error Resume Next
Sheets("SearchWord").Select
If Err  0 Then
ThisWorkbook.Sheets("SearchWord").Copy Before:=ActiveWorkbook.Worksheets(1)
End If

On Error GoTo Cancelled

'Clear old data and then format results page as required**********
Range("A3:F50").ClearContents
Range("A1:B1").Interior.ColorIndex = 6
Range("A1").Value = "Occurences of:"
If Reset = True Then Range("B1").Value = Search
Range("A1:D2").Font.Bold = True
Range("A2").Value = "Location"
Range("B2").Value = "Cell Text"
Range("A1:B1").HorizontalAlignment = xlLeft
Range("A2:B2").HorizontalAlignment = xlCenter
With Columns("A:A")
.ColumnWidth = 14
.VerticalAlignment = xlTop
End With
With Columns("B:B")
.ColumnWidth = 50
.VerticalAlignment = xlCenter
.WrapText = True
End With

For Counter = 1 To UBound(FindCell)
TextToDisplay:=FindSheet(Counter) & " - " & FindCell(Counter)
Range("B" & Counter + 2).Value = FindText(Counter)

'Add text from offset columns; probably not
'appropriate with whole sheet search
Range("C" & Counter + 2).Value = _
Sheets(FindSheet(Counter)).Range(FindCell(Counter)).Offset(0, 1)
Range("D" & Counter + 2).Value = _
Sheets(FindSheet(Counter)).Range(FindCell(Counter)).Offset(0, 2)
'*********************************************
Next Counter

'Find search term on results page and colour text
ColourText

Cancelled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Sub ColourText()
Dim Strt As Long, x As Long, i As Long
Columns("B:B").Characters.Font.ColorIndex = xlAutomatic
For i = 3 To Range("B" & Rows.Count).End(xlUp).Row
x = 1
Do
Strt = InStr(x, Range("B" & i), [B1], 1)
If Strt = 0 Then Exit Do
Range("B" & i).Characters(Start:=Strt, _
Length:=Len([B1])).Font.ColorIndex = 7
x = Strt + 1
Loop
Next
End Sub```
Thanks for looking,

I'm only new with VBA so be gentle please.