Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
Default 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


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,986
Default 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


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
Default 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


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
Default 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


  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
Default 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




  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,986
Default 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


  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
Default 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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

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


Similar Threads
Thread Thread Starter Forum Replies Last Post
Copy formulas from non-adjacent cells Mike O.[_2_] Excel Discussion (Misc queries) 0 October 22nd 09 06:21 PM
How to map cells to a reference then copy adjacent ones Dream Excel Discussion (Misc queries) 4 September 8th 09 08:37 AM
Copy and paste versus copy and insert copied cells Alana New Users to Excel 1 September 28th 07 08:58 PM
How do I fill (copy) nonadjacent cells to adjacent cells? BuckyGeorge Excel Discussion (Misc queries) 2 December 22nd 05 04:18 AM
How to use macros to copy a range of cells which can exclude some cells which I didn't want to be copied? excelnovice Excel Worksheet Functions 2 September 25th 05 12:38 AM


All times are GMT +1. The time now is 03:16 AM.

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

About Us

"It's about Microsoft Excel"