|
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
Search code help needed??
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 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 |
Search code help needed??
I managed to fix the error, it turned out to be just a few spaces where they
should not have been, no big deal, thank you very much for the code. "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 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 |
Search code help needed??
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 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 |
Search code help needed??
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 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 |
Search code help needed??
One last question. How would I go about renaming the newly created sheet? I
know it needs to be in or after this line of code. rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1") "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 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 |
Search code help needed??
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 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 |
Search code help needed??
I would do something like
If Not rgMatch Is Nothing Then ''' copy specific columns to new sheet in same book in B10 With wsh.Parent.Worksheets.Add .Name="NewName" application.Intersect(rgMatch.EntireRow,rgFrom).Co py .Range("B10") End With End If -- Regards, Sébastien <http://www.ondemandanalysis.com <http://www.ready-reports.com "Mekinnik" wrote: One last question. How would I go about renaming the newly created sheet? I know it needs to be in or after this line of code. rgMatch.EntireRow.Copy wsh.Parent.Worksheets.Add.Range("A1") "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 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 |
Search code help needed??
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 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 |
Search code help needed??
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 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 |
Search code help needed??
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 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 |
Search code help needed??
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 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 |
Search code help needed??
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 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 |
Search code help needed??
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 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() |
Search code help needed??
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 |
| All times are GMT +1. The time now is 11:33 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com