![]() |
copy adjacent cells also and put totals at the end (for copied cel
Hi
the following code finds cells and copies, but for one column only. (1) i want to copy adjacents cells of the found cells, using offset ? how can i do that? (2) and sum at the end for few few columns (3) one find is made at 1 column only but i need to find for 2, in two columns, if both match (in the same row) then some adjacent cells of the found cells have to be copied to another formatted sheet after row 15 ------------------------------------------------------------ I took the code from "Ron", fyi. thanks - Eddy stan Sub Copy_To_Another_Sheet_1() Dim FirstAddress As String Dim MyArr As Variant ' setting any array as variable Dim Rng As Range Dim Rng2 As Range Dim Rcount As Long Dim I As Long Dim NewSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With 'Fill in the search Value ' MyArr = Array("@") 'You can also use more values in the Array ' MyArr = Array("@", ".www") MyArr = Array(Range("F1").Value, Range("F2").Value) 'Add new worksheet to your workbook to copy to ' Set NewSh = Worksheets.Add 'You can also use a existing sheet like this Set NewSh = Sheets("Customer") With Sheets("Duelist").Range("A1:d159") ' Rcount = 0 Rcount = 15 ' leave top 15 rows. For I = LBound(MyArr) To UBound(MyArr) 'If you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "@" 'Note : I use xlPart in this example and not xlWhole Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.Copy NewSh.Range("A" & Rcount) ' Use this if you only want to copy the value ' NewSh.Range("A" & Rcount).Value = Rng.Value Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address < FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
copy adjacent cells also and put totals at the end (for copied cel
I don't believe VBA recognizes terms like "few" and "some". If you want to
copy more than one cell at a time, then you will need to furnish the criteria that determines when to do that, AND the criteria that determines how many addiditional cells are to be copied, AND wher the data is located that you want summarized. VBA needs to be told specifically what to do, it cannot operate on vague generalities. "Eddy Stan" wrote: Hi the following code finds cells and copies, but for one column only. (1) i want to copy adjacents cells of the found cells, using offset ? how can i do that? (2) and sum at the end for few few columns (3) one find is made at 1 column only but i need to find for 2, in two columns, if both match (in the same row) then some adjacent cells of the found cells have to be copied to another formatted sheet after row 15 ------------------------------------------------------------ I took the code from "Ron", fyi. thanks - Eddy stan Sub Copy_To_Another_Sheet_1() Dim FirstAddress As String Dim MyArr As Variant ' setting any array as variable Dim Rng As Range Dim Rng2 As Range Dim Rcount As Long Dim I As Long Dim NewSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With 'Fill in the search Value ' MyArr = Array("@") 'You can also use more values in the Array ' MyArr = Array("@", ".www") MyArr = Array(Range("F1").Value, Range("F2").Value) 'Add new worksheet to your workbook to copy to ' Set NewSh = Worksheets.Add 'You can also use a existing sheet like this Set NewSh = Sheets("Customer") With Sheets("Duelist").Range("A1:d159") ' Rcount = 0 Rcount = 15 ' leave top 15 rows. For I = LBound(MyArr) To UBound(MyArr) 'If you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "@" 'Note : I use xlPart in this example and not xlWhole Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.Copy NewSh.Range("A" & Rcount) ' Use this if you only want to copy the value ' NewSh.Range("A" & Rcount).Value = Rng.Value Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address < FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
copy adjacent cells also and put totals at the end (for copied
Hi
sorry i confused. Let me re-phrase my sentense. i am searching for one customer in one city, say Mcdowell at Washington (whereas customer Mcdowell is also there at Newyork & Califorinia, but i am searching for Mcdowell in Washington only. But the data would be in different rows like at row 20, 25, 250,500-505,700 (10rows but scattered). so want to copy cells in column b,c,d,e & f (for rows mentioned) but i want total for d,e & f ( as they are the number columns) and other columns/cells are text/date columns (2) all data is in one sheet and result i want in another sheet (refer my code below, with different sheet names). thank you for helping and i am just waiting for your code. eddy "JLGWhiz" wrote: I don't believe VBA recognizes terms like "few" and "some". If you want to copy more than one cell at a time, then you will need to furnish the criteria that determines when to do that, AND the criteria that determines how many addiditional cells are to be copied, AND wher the data is located that you want summarized. VBA needs to be told specifically what to do, it cannot operate on vague generalities. "Eddy Stan" wrote: Hi the following code finds cells and copies, but for one column only. (1) i want to copy adjacents cells of the found cells, using offset ? how can i do that? (2) and sum at the end for few few columns (3) one find is made at 1 column only but i need to find for 2, in two columns, if both match (in the same row) then some adjacent cells of the found cells have to be copied to another formatted sheet after row 15 ------------------------------------------------------------ I took the code from "Ron", fyi. thanks - Eddy stan Sub Copy_To_Another_Sheet_1() Dim FirstAddress As String Dim MyArr As Variant ' setting any array as variable Dim Rng As Range Dim Rng2 As Range Dim Rcount As Long Dim I As Long Dim NewSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With 'Fill in the search Value ' MyArr = Array("@") 'You can also use more values in the Array ' MyArr = Array("@", ".www") MyArr = Array(Range("F1").Value, Range("F2").Value) 'Add new worksheet to your workbook to copy to ' Set NewSh = Worksheets.Add 'You can also use a existing sheet like this Set NewSh = Sheets("Customer") With Sheets("Duelist").Range("A1:d159") ' Rcount = 0 Rcount = 15 ' leave top 15 rows. For I = LBound(MyArr) To UBound(MyArr) 'If you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "@" 'Note : I use xlPart in this example and not xlWhole Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.Copy NewSh.Range("A" & Rcount) ' Use this if you only want to copy the value ' NewSh.Range("A" & Rcount).Value = Rng.Value Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address < FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
copy adjacent cells also and put totals at the end (for copied
and one more thing what code should be to search for "absolute match" and
"partial match". (example: for absolute : upper/lower case ok but search "eddy stan" should be absolute, even "eddy.stan" must be ignored. for partial match : what should be the code if partial search is found in the cell like "stanley", "eddy stan" or "eddie". thanks n i am waiting... eddy "JLGWhiz" wrote: I don't believe VBA recognizes terms like "few" and "some". If you want to copy more than one cell at a time, then you will need to furnish the criteria that determines when to do that, AND the criteria that determines how many addiditional cells are to be copied, AND wher the data is located that you want summarized. VBA needs to be told specifically what to do, it cannot operate on vague generalities. "Eddy Stan" wrote: Hi the following code finds cells and copies, but for one column only. (1) i want to copy adjacents cells of the found cells, using offset ? how can i do that? (2) and sum at the end for few few columns (3) one find is made at 1 column only but i need to find for 2, in two columns, if both match (in the same row) then some adjacent cells of the found cells have to be copied to another formatted sheet after row 15 ------------------------------------------------------------ I took the code from "Ron", fyi. thanks - Eddy stan Sub Copy_To_Another_Sheet_1() Dim FirstAddress As String Dim MyArr As Variant ' setting any array as variable Dim Rng As Range Dim Rng2 As Range Dim Rcount As Long Dim I As Long Dim NewSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With 'Fill in the search Value ' MyArr = Array("@") 'You can also use more values in the Array ' MyArr = Array("@", ".www") MyArr = Array(Range("F1").Value, Range("F2").Value) 'Add new worksheet to your workbook to copy to ' Set NewSh = Worksheets.Add 'You can also use a existing sheet like this Set NewSh = Sheets("Customer") With Sheets("Duelist").Range("A1:d159") ' Rcount = 0 Rcount = 15 ' leave top 15 rows. For I = LBound(MyArr) To UBound(MyArr) 'If you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "@" 'Note : I use xlPart in this example and not xlWhole Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.Copy NewSh.Range("A" & Rcount) ' Use this if you only want to copy the value ' NewSh.Range("A" & Rcount).Value = Rng.Value Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address < FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
copy adjacent cells also and put totals at the end (for copied
Hi all,
please reply. "Eddy Stan" wrote: and one more thing what code should be to search for "absolute match" and "partial match". (example: for absolute : upper/lower case ok but search "eddy stan" should be absolute, even "eddy.stan" must be ignored. for partial match : what should be the code if partial search is found in the cell like "stanley", "eddy stan" or "eddie". thanks n i am waiting... eddy "JLGWhiz" wrote: I don't believe VBA recognizes terms like "few" and "some". If you want to copy more than one cell at a time, then you will need to furnish the criteria that determines when to do that, AND the criteria that determines how many addiditional cells are to be copied, AND wher the data is located that you want summarized. VBA needs to be told specifically what to do, it cannot operate on vague generalities. "Eddy Stan" wrote: Hi the following code finds cells and copies, but for one column only. (1) i want to copy adjacents cells of the found cells, using offset ? how can i do that? (2) and sum at the end for few few columns (3) one find is made at 1 column only but i need to find for 2, in two columns, if both match (in the same row) then some adjacent cells of the found cells have to be copied to another formatted sheet after row 15 ------------------------------------------------------------ I took the code from "Ron", fyi. thanks - Eddy stan Sub Copy_To_Another_Sheet_1() Dim FirstAddress As String Dim MyArr As Variant ' setting any array as variable Dim Rng As Range Dim Rng2 As Range Dim Rcount As Long Dim I As Long Dim NewSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With 'Fill in the search Value ' MyArr = Array("@") 'You can also use more values in the Array ' MyArr = Array("@", ".www") MyArr = Array(Range("F1").Value, Range("F2").Value) 'Add new worksheet to your workbook to copy to ' Set NewSh = Worksheets.Add 'You can also use a existing sheet like this Set NewSh = Sheets("Customer") With Sheets("Duelist").Range("A1:d159") ' Rcount = 0 Rcount = 15 ' leave top 15 rows. For I = LBound(MyArr) To UBound(MyArr) 'If you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "@" 'Note : I use xlPart in this example and not xlWhole Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.Copy NewSh.Range("A" & Rcount) ' Use this if you only want to copy the value ' NewSh.Range("A" & Rcount).Value = Rng.Value Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address < FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
copy adjacent cells also and put totals at the end (for copied
This might help you to get a better response.
http://www.cpearson.com/excel/HintsA...roupUsers.aspx "Eddy Stan" wrote: Hi all, please reply. "Eddy Stan" wrote: and one more thing what code should be to search for "absolute match" and "partial match". (example: for absolute : upper/lower case ok but search "eddy stan" should be absolute, even "eddy.stan" must be ignored. for partial match : what should be the code if partial search is found in the cell like "stanley", "eddy stan" or "eddie". thanks n i am waiting... eddy "JLGWhiz" wrote: I don't believe VBA recognizes terms like "few" and "some". If you want to copy more than one cell at a time, then you will need to furnish the criteria that determines when to do that, AND the criteria that determines how many addiditional cells are to be copied, AND wher the data is located that you want summarized. VBA needs to be told specifically what to do, it cannot operate on vague generalities. "Eddy Stan" wrote: Hi the following code finds cells and copies, but for one column only. (1) i want to copy adjacents cells of the found cells, using offset ? how can i do that? (2) and sum at the end for few few columns (3) one find is made at 1 column only but i need to find for 2, in two columns, if both match (in the same row) then some adjacent cells of the found cells have to be copied to another formatted sheet after row 15 ------------------------------------------------------------ I took the code from "Ron", fyi. thanks - Eddy stan Sub Copy_To_Another_Sheet_1() Dim FirstAddress As String Dim MyArr As Variant ' setting any array as variable Dim Rng As Range Dim Rng2 As Range Dim Rcount As Long Dim I As Long Dim NewSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With 'Fill in the search Value ' MyArr = Array("@") 'You can also use more values in the Array ' MyArr = Array("@", ".www") MyArr = Array(Range("F1").Value, Range("F2").Value) 'Add new worksheet to your workbook to copy to ' Set NewSh = Worksheets.Add 'You can also use a existing sheet like this Set NewSh = Sheets("Customer") With Sheets("Duelist").Range("A1:d159") ' Rcount = 0 Rcount = 15 ' leave top 15 rows. For I = LBound(MyArr) To UBound(MyArr) 'If you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "@" 'Note : I use xlPart in this example and not xlWhole Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.Copy NewSh.Range("A" & Rcount) ' Use this if you only want to copy the value ' NewSh.Range("A" & Rcount).Value = Rng.Value Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address < FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
copy adjacent cells also and put totals at the end (for copied
i will do that in my summer time !
but can anyone do better than this. "JLGWhiz" wrote: This might help you to get a better response. http://www.cpearson.com/excel/HintsA...roupUsers.aspx "Eddy Stan" wrote: Hi all, please reply. "Eddy Stan" wrote: and one more thing what code should be to search for "absolute match" and "partial match". (example: for absolute : upper/lower case ok but search "eddy stan" should be absolute, even "eddy.stan" must be ignored. for partial match : what should be the code if partial search is found in the cell like "stanley", "eddy stan" or "eddie". thanks n i am waiting... eddy "JLGWhiz" wrote: I don't believe VBA recognizes terms like "few" and "some". If you want to copy more than one cell at a time, then you will need to furnish the criteria that determines when to do that, AND the criteria that determines how many addiditional cells are to be copied, AND wher the data is located that you want summarized. VBA needs to be told specifically what to do, it cannot operate on vague generalities. "Eddy Stan" wrote: Hi the following code finds cells and copies, but for one column only. (1) i want to copy adjacents cells of the found cells, using offset ? how can i do that? (2) and sum at the end for few few columns (3) one find is made at 1 column only but i need to find for 2, in two columns, if both match (in the same row) then some adjacent cells of the found cells have to be copied to another formatted sheet after row 15 ------------------------------------------------------------ I took the code from "Ron", fyi. thanks - Eddy stan Sub Copy_To_Another_Sheet_1() Dim FirstAddress As String Dim MyArr As Variant ' setting any array as variable Dim Rng As Range Dim Rng2 As Range Dim Rcount As Long Dim I As Long Dim NewSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With 'Fill in the search Value ' MyArr = Array("@") 'You can also use more values in the Array ' MyArr = Array("@", ".www") MyArr = Array(Range("F1").Value, Range("F2").Value) 'Add new worksheet to your workbook to copy to ' Set NewSh = Worksheets.Add 'You can also use a existing sheet like this Set NewSh = Sheets("Customer") With Sheets("Duelist").Range("A1:d159") ' Rcount = 0 Rcount = 15 ' leave top 15 rows. For I = LBound(MyArr) To UBound(MyArr) 'If you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "@" 'Note : I use xlPart in this example and not xlWhole Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.Copy NewSh.Range("A" & Rcount) ' Use this if you only want to copy the value ' NewSh.Range("A" & Rcount).Value = Rng.Value Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address < FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
All times are GMT +1. The time now is 12:51 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com