Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default Search code help needed??

I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy befo=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet

NewRow = 5
With Sheets("ProCode")

Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then

'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 694
Default Search code help needed??

Hi,

1 Sub, 1 Function. Function FindAll returns all matching cells.
All found rows are copied into a new sheet in the same book of Procode.

Private Sub BtnGo_Click()
Dim rgMatch As Range '''' range of matches
Dim searchFor As String ''' string to search for
Dim wsh As Worksheet ''' where to search
Dim rgToSearch As Range ''' where to search

''' initialization
searchFor = Me.CbxDept.Text
Set wsh = Sheets("Procode")
Set rgToSearch = wsh.Range("M:M")

''' Search all matches
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

''' Process matches
If Not rgMatch Is Nothing Then
''' copy rows to new sheet in same book
rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1")
End If

End Sub

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range
Dim rgResult As Range
Dim cell As Range
Dim firstAddr As String

With where
Set cell = .Find(what, lookIn:=lookIn, lookAt:=lookAt)
If Not cell Is Nothing Then
firstAddr = cell.Address
Do
''' add cell to result range
If rgResult Is Nothing Then
Set rgResult = cell
Else
Set rgResult = Application.Union(rgResult, cell)
End If
''' find next match
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address < firstAddr
End If
End With

Set FindAll = rgResult
End Function

--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy befo=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet

NewRow = 5
With Sheets("ProCode")

Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then

'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default Search code help needed??

I have tried to use the function, however it will not allow me to add the
parts within the (), any suggestions?

"sebastienm" wrote:

Hi,

1 Sub, 1 Function. Function FindAll returns all matching cells.
All found rows are copied into a new sheet in the same book of Procode.

Private Sub BtnGo_Click()
Dim rgMatch As Range '''' range of matches
Dim searchFor As String ''' string to search for
Dim wsh As Worksheet ''' where to search
Dim rgToSearch As Range ''' where to search

''' initialization
searchFor = Me.CbxDept.Text
Set wsh = Sheets("Procode")
Set rgToSearch = wsh.Range("M:M")

''' Search all matches
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

''' Process matches
If Not rgMatch Is Nothing Then
''' copy rows to new sheet in same book
rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1")
End If

End Sub

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range
Dim rgResult As Range
Dim cell As Range
Dim firstAddr As String

With where
Set cell = .Find(what, lookIn:=lookIn, lookAt:=lookAt)
If Not cell Is Nothing Then
firstAddr = cell.Address
Do
''' add cell to result range
If rgResult Is Nothing Then
Set rgResult = cell
Else
Set rgResult = Application.Union(rgResult, cell)
End If
''' find next match
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address < firstAddr
End If
End With

Set FindAll = rgResult
End Function

--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy befo=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet

NewRow = 5
With Sheets("ProCode")

Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then

'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 694
Default Search code help needed??

it will not allow me to add the parts within the ( ),
What '( )' ? for FindAll?
Do you have an example?
In the code , I use:
FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)
What error do you get on the above line?
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I have tried to use the function, however it will not allow me to add the
parts within the (), any suggestions?

"sebastienm" wrote:

Hi,

1 Sub, 1 Function. Function FindAll returns all matching cells.
All found rows are copied into a new sheet in the same book of Procode.

Private Sub BtnGo_Click()
Dim rgMatch As Range '''' range of matches
Dim searchFor As String ''' string to search for
Dim wsh As Worksheet ''' where to search
Dim rgToSearch As Range ''' where to search

''' initialization
searchFor = Me.CbxDept.Text
Set wsh = Sheets("Procode")
Set rgToSearch = wsh.Range("M:M")

''' Search all matches
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

''' Process matches
If Not rgMatch Is Nothing Then
''' copy rows to new sheet in same book
rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1")
End If

End Sub

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range
Dim rgResult As Range
Dim cell As Range
Dim firstAddr As String

With where
Set cell = .Find(what, lookIn:=lookIn, lookAt:=lookAt)
If Not cell Is Nothing Then
firstAddr = cell.Address
Do
''' add cell to result range
If rgResult Is Nothing Then
Set rgResult = cell
Else
Set rgResult = Application.Union(rgResult, cell)
End If
''' find next match
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address < firstAddr
End If
End With

Set FindAll = rgResult
End Function

--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy befo=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet

NewRow = 5
With Sheets("ProCode")

Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then

'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default Search code help needed??

I get en error at that line, is it maybe the function?? Here is what you
labeled it

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range


They do not match, do I just change what is in ()??

"sebastienm" wrote:

it will not allow me to add the parts within the ( ),

What '( )' ? for FindAll?
Do you have an example?
In the code , I use:
FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)
What error do you get on the above line?
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I have tried to use the function, however it will not allow me to add the
parts within the (), any suggestions?

"sebastienm" wrote:

Hi,

1 Sub, 1 Function. Function FindAll returns all matching cells.
All found rows are copied into a new sheet in the same book of Procode.

Private Sub BtnGo_Click()
Dim rgMatch As Range '''' range of matches
Dim searchFor As String ''' string to search for
Dim wsh As Worksheet ''' where to search
Dim rgToSearch As Range ''' where to search

''' initialization
searchFor = Me.CbxDept.Text
Set wsh = Sheets("Procode")
Set rgToSearch = wsh.Range("M:M")

''' Search all matches
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

''' Process matches
If Not rgMatch Is Nothing Then
''' copy rows to new sheet in same book
rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1")
End If

End Sub

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range
Dim rgResult As Range
Dim cell As Range
Dim firstAddr As String

With where
Set cell = .Find(what, lookIn:=lookIn, lookAt:=lookAt)
If Not cell Is Nothing Then
firstAddr = cell.Address
Do
''' add cell to result range
If rgResult Is Nothing Then
Set rgResult = cell
Else
Set rgResult = Application.Union(rgResult, cell)
End If
''' find next match
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address < firstAddr
End If
End With

Set FindAll = rgResult
End Function

--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy befo=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet

NewRow = 5
With Sheets("ProCode")

Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then

'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 694
Default Search code help needed??

Not sure what does not match here. The call passes all 4 necessary parameters
for where, what, lookIn and lookAt. And it works on my machine.
What error number and description do you get?

--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I get en error at that line, is it maybe the function?? Here is what you
labeled it

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range


They do not match, do I just change what is in ()??

"sebastienm" wrote:

it will not allow me to add the parts within the ( ),

What '( )' ? for FindAll?
Do you have an example?
In the code , I use:
FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)
What error do you get on the above line?
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I have tried to use the function, however it will not allow me to add the
parts within the (), any suggestions?

"sebastienm" wrote:

Hi,

1 Sub, 1 Function. Function FindAll returns all matching cells.
All found rows are copied into a new sheet in the same book of Procode.

Private Sub BtnGo_Click()
Dim rgMatch As Range '''' range of matches
Dim searchFor As String ''' string to search for
Dim wsh As Worksheet ''' where to search
Dim rgToSearch As Range ''' where to search

''' initialization
searchFor = Me.CbxDept.Text
Set wsh = Sheets("Procode")
Set rgToSearch = wsh.Range("M:M")

''' Search all matches
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

''' Process matches
If Not rgMatch Is Nothing Then
''' copy rows to new sheet in same book
rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1")
End If

End Sub

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range
Dim rgResult As Range
Dim cell As Range
Dim firstAddr As String

With where
Set cell = .Find(what, lookIn:=lookIn, lookAt:=lookAt)
If Not cell Is Nothing Then
firstAddr = cell.Address
Do
''' add cell to result range
If rgResult Is Nothing Then
Set rgResult = cell
Else
Set rgResult = Application.Union(rgResult, cell)
End If
''' find next match
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address < firstAddr
End If
End With

Set FindAll = rgResult
End Function

--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy befo=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet

NewRow = 5
With Sheets("ProCode")

Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then

'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default Search code help needed??

Sorry, I get a compile error (wrong number of arguments or invalid property
assignment)at the following line:
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

"sebastienm" wrote:

it will not allow me to add the parts within the ( ),

What '( )' ? for FindAll?
Do you have an example?
In the code , I use:
FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)
What error do you get on the above line?
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I have tried to use the function, however it will not allow me to add the
parts within the (), any suggestions?

"sebastienm" wrote:

Hi,

1 Sub, 1 Function. Function FindAll returns all matching cells.
All found rows are copied into a new sheet in the same book of Procode.

Private Sub BtnGo_Click()
Dim rgMatch As Range '''' range of matches
Dim searchFor As String ''' string to search for
Dim wsh As Worksheet ''' where to search
Dim rgToSearch As Range ''' where to search

''' initialization
searchFor = Me.CbxDept.Text
Set wsh = Sheets("Procode")
Set rgToSearch = wsh.Range("M:M")

''' Search all matches
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

''' Process matches
If Not rgMatch Is Nothing Then
''' copy rows to new sheet in same book
rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1")
End If

End Sub

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range
Dim rgResult As Range
Dim cell As Range
Dim firstAddr As String

With where
Set cell = .Find(what, lookIn:=lookIn, lookAt:=lookAt)
If Not cell Is Nothing Then
firstAddr = cell.Address
Do
''' add cell to result range
If rgResult Is Nothing Then
Set rgResult = cell
Else
Set rgResult = Application.Union(rgResult, cell)
End If
''' find next match
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address < firstAddr
End If
End With

Set FindAll = rgResult
End Function

--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy befo=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet

NewRow = 5
With Sheets("ProCode")

Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then

'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default Search code help needed??

I copied and pasted the code you posted right into my project and added the
fuction to my form, should I have added it to a module instead? I did try it
and it would not allow me to add it it kept marking the first line in red. I
am using excel 2007 is it maybe that I have something not enabled?

"Mekinnik" wrote:

Sorry, I get a compile error (wrong number of arguments or invalid property
assignment)at the following line:
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

"sebastienm" wrote:

it will not allow me to add the parts within the ( ),

What '( )' ? for FindAll?
Do you have an example?
In the code , I use:
FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)
What error do you get on the above line?
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I have tried to use the function, however it will not allow me to add the
parts within the (), any suggestions?

"sebastienm" wrote:

Hi,

1 Sub, 1 Function. Function FindAll returns all matching cells.
All found rows are copied into a new sheet in the same book of Procode.

Private Sub BtnGo_Click()
Dim rgMatch As Range '''' range of matches
Dim searchFor As String ''' string to search for
Dim wsh As Worksheet ''' where to search
Dim rgToSearch As Range ''' where to search

''' initialization
searchFor = Me.CbxDept.Text
Set wsh = Sheets("Procode")
Set rgToSearch = wsh.Range("M:M")

''' Search all matches
Set rgMatch = FindAll(rgToSearch, searchFor & "*", xlValues, xlWhole)

''' Process matches
If Not rgMatch Is Nothing Then
''' copy rows to new sheet in same book
rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1")
End If

End Sub

Function FindAll(where As Range, what As Variant, lookIn As XlFindLookIn,
lookAt As XlLookAt) As Range
Dim rgResult As Range
Dim cell As Range
Dim firstAddr As String

With where
Set cell = .Find(what, lookIn:=lookIn, lookAt:=lookAt)
If Not cell Is Nothing Then
firstAddr = cell.Address
Do
''' add cell to result range
If rgResult Is Nothing Then
Set rgResult = cell
Else
Set rgResult = Application.Union(rgResult, cell)
End If
''' find next match
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address < firstAddr
End If
End With

Set FindAll = rgResult
End Function

--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy befo=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet

NewRow = 5
With Sheets("ProCode")

Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then

'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Very Urgent - Find / Search Help Needed TGV Excel Discussion (Misc queries) 8 June 28th 09 03:00 PM
Macro needed to search 2 columns Mekinnik Excel Programming 2 October 31st 07 07:54 PM
search or goto command needed. mightymax Excel Programming 1 July 26th 04 03:42 AM
Excel XP VBA code to search all macro code in Excel module for specific search string criteria Ed[_18_] Excel Programming 4 May 20th 04 02:08 PM
Excel XP VBA code to search all macro code in Excel module for specific search string criteria Frank Kabel Excel Programming 0 May 19th 04 08:11 PM


All times are GMT +1. The time now is 02:09 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"