ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   copy adjacent cells also and put totals at the end (for copied cel (https://www.excelbanter.com/excel-programming/420415-copy-adjacent-cells-also-put-totals-end-copied-cel.html)

Eddy Stan

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



JLGWhiz

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



Eddy Stan

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



Eddy Stan

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



Eddy Stan

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



JLGWhiz

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



Eddy Stan

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