loveguy1977
05-01-2013, 04:11 AM
Dear All,
I'm having a macro for search and all within the same file as folow:
FILE CAN BE DOWNLOADED FROM HERE
http://www.excelhero.com/blog/workbooks/partial_match_lookup_excelhero.com.xls
Sheet"Search" has this vba
Option Explicit
Private Sub Worksheet_Activate()
[c3] = "Type your search here."
[c3].Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
If Range("C3") = "Type your search here." Then Exit Sub
If Not Intersect(Target, Range("Range_to_Copy_From")) Is Nothing Then
Call Copy_Data
Else
' Me.Select
End If
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 = "c9:f65536"
Const COLS_TO_DISPLAY = 4
Const KEY_COL = "c"
Const ROW_1 = 1
Const SEARCH_SHEET = "data"
Const SEARCH_RANGE = "b2:b65536"
' If change was from any cell other than our lookup, then exit
If Intersect(Target, Range(CELL_WITH_LOOKUP_VALUE)) Is Nothing Then Exit Sub
[c3].Select
' Clear previous search results
Me.Unprotect
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Range(RESULTS_RANGE).ClearContents
' Get range of cells that contain search string
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
' [A11] = "AAAAA"
' Display search results
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
Me.Protect
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
' By Chip Pearson, chip@cpearson.com. www.cpearson.com (http://www.cpearson.com)
' FindAll
' This returns a Range object that contains all the cells in SearchRange in which FindWhat
' was found. The parameters to the function have the same meaning as they do for the
' Find method of the Range object. If no cells were found, the result of this function
' is Nothing.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' In order to have Find search for the FindWhat value
' starting at the first cell in the SearchRange, we
' have to find the last cell in SearchRange and use
' that as the cell after which the Find will search.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set LastCell = .Cells(.Cells.Count)
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Do the initial Find. If we don't find FindWhat in the first Find,
' we won't even go into the code which searches for subsequent
' occurances.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set FoundCell = SearchRange.Find(What:=FindWhat, After:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
''''''''''''''''''''''''''''''
' Set the FoundCells range
' to the first FoundCell.
''''''''''''''''''''''''''''''
Set FoundCells = FoundCell
''''''''''''''''''''''''''''
' FirstAddr will contain the
' address of the first found
' cell. We test each FoundCell
' to this address to prevent
' the Find from looping back
' through the range it has
' already searched.
''''''''''''''''''''''''''''
FirstAddr = FoundCell.Address
Do
''''''''''''''''''''''''''''''''
' Loop calling FindNext until
' FoundCell is nothing or
' we wrap around the first
' found cell (address is in
' FirstAddr).
'''''''''''''''''''''''''''''''
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(After:=FoundCell)
'Set FoundCell = SearchRange.Find(what:=vbNullString, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
'Set FoundCell = FoundCell.Offset(, -1)
'Stop
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
''''''''''''''''''''
' Return the result.
''''''''''''''''''''
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function
Sheet"Data" is my data (which is refer to above vba as Const SEARCH_SHEET = "data")
My needs here, i need to move Sheet"Data" to another file then how can I linke above vba to Sheet"Data" that moved to another file?
Infact, that file will be as addins file (.xlam)
Thank you very much
I'm having a macro for search and all within the same file as folow:
FILE CAN BE DOWNLOADED FROM HERE
http://www.excelhero.com/blog/workbooks/partial_match_lookup_excelhero.com.xls
Sheet"Search" has this vba
Option Explicit
Private Sub Worksheet_Activate()
[c3] = "Type your search here."
[c3].Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
If Range("C3") = "Type your search here." Then Exit Sub
If Not Intersect(Target, Range("Range_to_Copy_From")) Is Nothing Then
Call Copy_Data
Else
' Me.Select
End If
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 = "c9:f65536"
Const COLS_TO_DISPLAY = 4
Const KEY_COL = "c"
Const ROW_1 = 1
Const SEARCH_SHEET = "data"
Const SEARCH_RANGE = "b2:b65536"
' If change was from any cell other than our lookup, then exit
If Intersect(Target, Range(CELL_WITH_LOOKUP_VALUE)) Is Nothing Then Exit Sub
[c3].Select
' Clear previous search results
Me.Unprotect
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Range(RESULTS_RANGE).ClearContents
' Get range of cells that contain search string
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
' [A11] = "AAAAA"
' Display search results
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
Me.Protect
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
' By Chip Pearson, chip@cpearson.com. www.cpearson.com (http://www.cpearson.com)
' FindAll
' This returns a Range object that contains all the cells in SearchRange in which FindWhat
' was found. The parameters to the function have the same meaning as they do for the
' Find method of the Range object. If no cells were found, the result of this function
' is Nothing.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' In order to have Find search for the FindWhat value
' starting at the first cell in the SearchRange, we
' have to find the last cell in SearchRange and use
' that as the cell after which the Find will search.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set LastCell = .Cells(.Cells.Count)
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Do the initial Find. If we don't find FindWhat in the first Find,
' we won't even go into the code which searches for subsequent
' occurances.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set FoundCell = SearchRange.Find(What:=FindWhat, After:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
''''''''''''''''''''''''''''''
' Set the FoundCells range
' to the first FoundCell.
''''''''''''''''''''''''''''''
Set FoundCells = FoundCell
''''''''''''''''''''''''''''
' FirstAddr will contain the
' address of the first found
' cell. We test each FoundCell
' to this address to prevent
' the Find from looping back
' through the range it has
' already searched.
''''''''''''''''''''''''''''
FirstAddr = FoundCell.Address
Do
''''''''''''''''''''''''''''''''
' Loop calling FindNext until
' FoundCell is nothing or
' we wrap around the first
' found cell (address is in
' FirstAddr).
'''''''''''''''''''''''''''''''
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(After:=FoundCell)
'Set FoundCell = SearchRange.Find(what:=vbNullString, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
'Set FoundCell = FoundCell.Offset(, -1)
'Stop
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
''''''''''''''''''''
' Return the result.
''''''''''''''''''''
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function
Sheet"Data" is my data (which is refer to above vba as Const SEARCH_SHEET = "data")
My needs here, i need to move Sheet"Data" to another file then how can I linke above vba to Sheet"Data" that moved to another file?
Infact, that file will be as addins file (.xlam)
Thank you very much