You're right, i switched the two of them. Good catch.
Glad I could help.
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

Thank you for all the help with this one problem, however I have to point out
that you got the naming code wrong, but but a problem. It is suppose to be:
To rename the origin sheet, use:
wsh.Name = searchFor
To rename the destination (new) sheet, use :
.Name = searchFor

NOT:

To rename the origin sheet, use:
.Name = searchFor
To rename the destination (new) sheet, use :
wsh.Name = searchFor

But like I said not a problem. Again thank you for all your help, I am sure
more problems will arise, again thank you.

"sebastienm" wrote:

You are using the Add multiple times instead of just once. Instead:
With wsh.Parent.Worksheets.Add
''' copy 1st column: M-A
Application.Intersect(rgMatch.EntireRow, wsh.Range("M:M")).Copy _
.Range("A1")
''' copy second column : C-I

Application.Intersect(rgMatch.EntireRow, wsh.Range("C:C")).Copy _
.Range("I1")
''' third column: D-I
'''(....)

End With

You had added a bunch of
wsh.Parent.Worksheets.Add.Range(...)
instead of just
.Range(...) (the dot in fornt of the Range is important here!!!)
which created a new sheet each time

Then somwewhere within the above With ... End :
To rename the origin sheet, use:
.Name = searchFor
To rename the destination (new) sheet, use :
wsh.Name = searchFor
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

The problem is is that it is not renaming the sheet that the copied data is
in, it is creating a new sheet with the new mane? Where should I have placed
the renaming line, here is what I have currently. Also how do I copy the data
in one sheet with what I have now it creates two sheets? Any suggestions?

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
Dim RgFrom As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'copies all data that matches 'T' to new sheet
searchFor = Me.CbxDept.Text
Set wsh = Sheets("Procode")
Set rgToSearch = wsh.Range("M:M")
Set RgFrom = wsh.Range("A1:M1").EntireColumn

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

''' Process matches
If Not rgMatch Is Nothing Then
''' copy specific columns to new sheet in same book in B10
With wsh.Parent.Worksheets.Add
''' copy 1st column: M-A
Application.Intersect(rgMatch.EntireRow, wsh.Range("M:M")).Copy _
wsh.Parent.Worksheets.Add.Range("A1")
''' copy second column : C-I
.Name = searchFor
Application.Intersect(rgMatch.EntireRow, wsh.Range("C:C")).Copy _
wsh.Parent.Worksheets.Add.Range("I1")
''' third column: D-I

End With
End If
End Sub

"sebastienm" wrote:

hmm strange; the following code works for me.

Sub Test()

Dim wsh As Worksheet

Set wsh = Worksheets("Procode")
''' creates a new sheet and rename the new sheet to NewName
With wsh.Parent.Worksheets.Add
.Name = "NewName"
End With

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


"Mekinnik" wrote:

There is a problem with the rename line of the code. It creates another sheet
with the new name it does not rename the created sheet that the data was
copied to. Any suggestions? I have tried all different types of ways to
rename the created sheet, but with just failure.

"sebastienm" wrote:

Unfortunately, when copying a range (even a multiple area range), it get
pasted as a continuous range. That is, to achieve what you are saying , you
would have to do multiple copy/paste, one for each column:

If Not rgMatch Is Nothing Then
''' copy specific columns to new sheet in same book in B10
With wsh.Parent.Worksheets.Add
.Name="NewName"
''' copy 1st column: B-B
application.Intersect(rgMatch.EntireRow,wsh.Range( "B:B"))).Copy _
.Range("B10")
''' copy second column : C-H
application.Intersect(rgMatch.EntireRow,wsh.Range( "C:C"))).Copy _
.Range("H10")
''' third column: D-I
''' ...
End With
End If

or instead of individual column, you could copy/paste continuous section
eg: C:J - H:O

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


"Mekinnik" wrote:

this is what I am tring to accomplish. From the copied data columns(copied
from to copied to) B=B,C=H,D=I,E=J,F=K,G=L,H=M,I=N,J=O,K=Q,L=R, and M=A

"sebastienm" wrote:

You would just need to change to final code:
If Not rgMatch Is Nothing Then
(...)

So, say you want to copy matching cells from columns B-D,M to new sheet
starting in cell B10. Do something like (not tested but should be close):

Dim RgFrom as range
Set rgFrom =wsh.range("B1:D1,M1").EntireColumn

If Not rgMatch Is Nothing Then
''' copy specific columns to new sheet in same book in B10
application.Intersect(rgMatch.EntireRow,rgFrom).Co py _
wsh.Parent.Worksheets.Add.Range("B10")
End If

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


"Mekinnik" wrote:

Is it possible to change what column to place the data in on the newly
created sheet?

"sebastienm" wrote:

doesn't compile, hu?! Strange.

The post shows the function top line on 2 lines due to the newsgroup posting
tool (the first line ends with a comma).
Function FindAll( ... ,
lookAt As XlLookAt) As Range
Of course, this should be on a single line
Function FindAll( ... , lookAt As XlLookAt) As Range

Search the xl2007 documentation for the Range.Find function (that i use in
FindAll) and make sure the syntax matches the 2007 syntax. But I now remember
having some 2003 books using FindAll that my users run on 2007 without any
problem, so I don't think there is an issue there.

Let me know if what you find
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Mekinnik" wrote:

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