HI again group,

I am almost breaking my head to successfully write a macro for what I
am trying to accomplish...

1. Look in range A1:A65536.
2. IF any cell value in range A1:A65536 starts with the word
"perform", THEN FIND that cell and copy it and the next 276 values and
paste in the adjacent columns..

Example:
Assuming cell A6 has the word "performance 1", cell A400 has the word
"performance 2" and cell A878 has the word "perform23", then, copy
cells A6 thru A281 (interval - 276) and paste in cell B1.
Copy cell A400 thru A675 (interval - 276) and paste in cell C1.
Copy cell 878 thru 1153 (interval - 276) and paste in cell D1.
etc...

Any help would be greatly helpful.. I am really blowing my mind here
to get this working.

Kevin

Try to adapt this code
Sub findinList()
Dim c As Range, s As Long
Range("A1:A65536").Select
Set c = Selection.Find("Perform")
'Do your thing
'Find a way to process next value
End Sub

" wrote:

HI again group,

I am almost breaking my head to successfully write a macro for what I
am trying to accomplish...

1. Look in range A1:A65536.
2. IF any cell value in range A1:A65536 starts with the word
"perform", THEN FIND that cell and copy it and the next 276 values and
paste in the adjacent columns..

Example:
Assuming cell A6 has the word "performance 1", cell A400 has the word
"performance 2" and cell A878 has the word "perform23", then, copy
cells A6 thru A281 (interval - 276) and paste in cell B1.
Copy cell A400 thru A675 (interval - 276) and paste in cell C1.
Copy cell 878 thru 1153 (interval - 276) and paste in cell D1.
etc...

Any help would be greatly helpful.. I am really blowing my mind here
to get this working.

Kevin

Let us know if you are unable to complete this on your own...

___________________________________________
Found this in Excel Help
When the search reaches the end of the specified search range, it wraps
around to the beginning of the range. To stop a search when this wraparound
occurs, save the address of the first found cell, and then test each
successive found-cell address against this saved address.

Example
This example finds all cells in the range A1:A500 that contain the value 2
and changes their values to 5.

With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With



" wrote:

HI again group,

I am almost breaking my head to successfully write a macro for what I
am trying to accomplish...

1. Look in range A1:A65536.
2. IF any cell value in range A1:A65536 starts with the word
"perform", THEN FIND that cell and copy it and the next 276 values and
paste in the adjacent columns..

Example:
Assuming cell A6 has the word "performance 1", cell A400 has the word
"performance 2" and cell A878 has the word "perform23", then, copy
cells A6 thru A281 (interval - 276) and paste in cell B1.
Copy cell A400 thru A675 (interval - 276) and paste in cell C1.
Copy cell 878 thru 1153 (interval - 276) and paste in cell D1.
etc...

Any help would be greatly helpful.. I am really blowing my mind here
to get this working.

Kevin

This should do it -- u may need to adjust the value of i to get the 276 line
criteria correct


Sub tst()
Dim i As Integer
Dim j As Integer
Dim a As String
Dim b As String
Dim c As String
i = 276
j = 0
Range("A1").Select
Do Until ActiveCell.Address = "$A$65536"
If Left(ActiveCell.Value, 7) = "perform" Then
j = j + 1
a = ActiveCell.Address
ActiveCell.Offset(i, 0).Activate
b = ActiveCell.Address
c = a & ":" & b
Range(c).Copy
Range(a).Select
ActiveCell.Offset(0, j).PasteSpecial
ActiveCell.Offset(1, -j).Activate
Else: ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("A1").Select
End Sub

" wrote:

HI again group,

I am almost breaking my head to successfully write a macro for what I
am trying to accomplish...

1. Look in range A1:A65536.
2. IF any cell value in range A1:A65536 starts with the word
"perform", THEN FIND that cell and copy it and the next 276 values and
paste in the adjacent columns..

Example:
Assuming cell A6 has the word "performance 1", cell A400 has the word
"performance 2" and cell A878 has the word "perform23", then, copy
cells A6 thru A281 (interval - 276) and paste in cell B1.
Copy cell A400 thru A675 (interval - 276) and paste in cell C1.
Copy cell 878 thru 1153 (interval - 276) and paste in cell D1.
etc...

Any help would be greatly helpful.. I am really blowing my mind here
to get this working.

Kevin

Hi Kevin

This shoud do it. Just notice that it will fail if "performance" is
found below row 65260, but maybe it's not a problem?

Sub Kevin()

Set found = Range("A1:A65536").Find(What:="performance",
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not found Is Nothing Then
found.Resize(277, 1).Copy Destination:=Range("B1")
fCell = found.Address
Else
msg = MsgBox("Performance was not found!", vbExclamation)
Exit Sub
End If
off = 1
Set Target = Range(found.Address)
Do
Set found = Range("A1:A65536").FindNext(After:=Target)
If found.Address = fCell Then Exit Do
found.Resize(277, 1).Copy Destination:=Range("B1").Offset(0, off)
off = off + 1
Set Target = Range(found.Address)
Loop

End Sub

Regards,
Per

On 29 Okt., 00:26, wrote:
HI again group,

I am almost breaking my head to successfully write a macro for what I
am trying to accomplish...

1. Look in range A1:A65536.
2. IF any cell value in range A1:A65536 starts with the word
"perform", THEN FIND that cell and copy it and the next 276 values and
paste in the adjacent columns..

Example:
Assuming cell A6 has the word "performance 1", cell A400 has the word
"performance 2" and cell A878 has the word "perform23", then, copy
cells A6 thru A281 (interval - 276) and paste in cell B1.
Copy cell A400 thru A675 (interval - 276) and paste in cell C1.
Copy cell 878 thru 1153 (interval - 276) and paste in cell D1.
etc...

Any help would be greatly helpful.. I am really blowing my mind here
to get this working.

Kevin

On Oct 28, 6:15*pm, Per Jessen wrote:
Hi Kevin

This shoud do it. Just notice that it will fail if "performance" is
found below row 65260, but maybe it's not a problem?

Sub Kevin()

Set found = Range("A1:A65536").Find(What:="performance",
After:=Range("A1"), LookIn:=xlValues, _
* * LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
* * MatchCase:=False)
If Not found Is Nothing Then
* * found.Resize(277, 1).Copy Destination:=Range("B1")
* * fCell = found.Address
Else
* * msg = MsgBox("Performance was not found!", vbExclamation)
* * Exit Sub
End If
off = 1
Set Target = Range(found.Address)
Do
* * Set found = Range("A1:A65536").FindNext(After:=Target)
* * If found.Address = fCell Then Exit Do
* * found.Resize(277, 1).Copy Destination:=Range("B1").Offset(0, off)
* * off = off + 1
* * Set Target = Range(found.Address)
Loop

End Sub

Regards,
Per

On 29 Okt., 00:26, wrote:



HI again group,

I am almost breaking my head to successfully write a macro for what I
am trying to accomplish...

1. Look in range A1:A65536.
2. IF any cell value in range A1:A65536 starts with the word
"perform", THEN FIND that cell and copy it and the next 276 values and
paste in the adjacent columns..

Example:
Assuming cell A6 has the word "performance 1", cell A400 has the word
"performance 2" and cell A878 has the word "perform23", then, copy
cells A6 thru A281 (interval - 276) and paste in cell B1.
Copy cell A400 thru A675 (interval - 276) and paste in cell C1.
Copy cell 878 thru 1153 (interval - 276) and paste in cell D1.
etc...

Any help would be greatly helpful.. I am really blowing my mind here
to get this working.

Kevin- Hide quoted text -

- Show quoted text -

Thank you all. Per's code solved my problem.

I've generated 30 sheets in the same workbook. Existing code works by
copying and pasting the values in the adjacent columns (B, C etc...)
Instead of pasting in the adjacent columns, how do I need to tweak the
code to paste in the adjacent sheets? Please let me know...

Using the following code, I will have a master sheet named "Sheet1"
where this macro and the Per's macro will reside and 30 additional
sheets will be generated (named 0 thru 29)...

Dim count As Integer
For count = 1 To 30
Worksheets.Add after:=Sheets(Sheets.count)
Sheets(count + 1).Name = count - 1
Next count

Hi Kevin

Thanks for your reply.

I assume that you want to have data pasted to cell A1 and down on
sheets 0-29.
This should do it:

Sub Kevin()
Dim shCount As String
Sheets("Sheet1").Activate
Set found = Range("A1:A65536").Find(What:="performance",
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not found Is Nothing Then
found.Resize(277, 1).Copy Destination:=Sheets("0").Range("A1")
fCell = found.Address
Else
msg = MsgBox("Performance was not found!", vbExclamation)
Exit Sub
End If
shCount = 1
Set Target = Sheets("Sheet1").Range(found.Address)
Do
Set found = Range("A1:A65536").FindNext(After:=Target)
If found.Address = fCell Then Exit Do
found.Resize(277, 1).Copy Destination:=Sheets(shCount).Range("A1")
shCount = shCount + 1
Set Target = Sheets("Sheet1").Range(found.Address)
Loop

End Sub

Regards,
Per


Thank you all. Per's code solved my problem.

I've generated 30 sheets in the same workbook. Existing code works by
copying and pasting the values in the adjacent columns (B, C etc...)
Instead of pasting in the adjacent columns, how do I need to tweak the
code to paste in the adjacent sheets? Please let me know...

Using the following code, I will have a master sheet named "Sheet1"
where this macro and the Per's macro will reside and 30 additional
sheets will be generated (named 0 thru 29)...

Dim count As Integer
For count = 1 To 30
Worksheets.Add after:=Sheets(Sheets.count)
Sheets(count + 1).Name = count - 1
Next count- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

On Oct 28, 8:35*pm, Per Jessen wrote:
Hi Kevin

Thanks for your reply.

I assume that you want to have data pasted to cell A1 and down on
sheets 0-29.
This should do it:

Sub Kevin()
Dim shCount As String
Sheets("Sheet1").Activate
Set found = Range("A1:A65536").Find(What:="performance",
After:=Range("A1"), LookIn:=xlValues, _
* * LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
* * MatchCase:=False)
If Not found Is Nothing Then
* * found.Resize(277, 1).Copy Destination:=Sheets("0").Range("A1")
* * fCell = found.Address
Else
* * msg = MsgBox("Performance was not found!", vbExclamation)
* * Exit Sub
End If
shCount = 1
Set Target = Sheets("Sheet1").Range(found.Address)
Do
* * Set found = Range("A1:A65536").FindNext(After:=Target)
* * If found.Address = fCell Then Exit Do
* * found.Resize(277, 1).Copy Destination:=Sheets(shCount).Range("A1")
* * shCount = shCount + 1
* * Set Target = Sheets("Sheet1").Range(found.Address)
Loop

End Sub

Regards,
Per



Thank you all. Per's code solved my problem.

I've generated 30 sheets in the same workbook. Existing code works by
copying and pasting the values in the adjacent columns (B, C etc...)
Instead of pasting in the adjacent columns, how do I need to tweak the
code to paste in the adjacent sheets? Please let me know...

Using the following code, I will have a master sheet named "Sheet1"
where this macro and the Per's macro will reside and 30 additional
sheets will be generated (named 0 thru 29)...

Dim count As Integer
For count = 1 To 30
Worksheets.Add after:=Sheets(Sheets.count)
Sheets(count + 1).Name = count - 1
Next count- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

Hi Per,

Yes, this code exactly does what I wanted.
Unfortunately, I found a glitch in my interpretation. The interval is
not always 276. Its sometimes 300+ and sometimes 240-ish...
I am now wondering how to tweak your macro to reflect this. Basically,
the algorithm would be to look for cell starting with "perform", in
this case its fCell; and look for the next cell starting containing
"perform", subtract -1 from the address and copy the range.

Considering the previous example, A6 will be the first location, A400
will be the second location, so grab all values from A6 to A399, ...
and paste in the adjacent sheets (as done before)..

This should do the trick for me.

Per, I have couple more scenarios too but the previous one is of
primary importance.
1. In addition to grabbing A6 thru A399, how would I grab A3 thru
A399; the word "perform" still being in the cell A6
2. Instead of grabbing A6 thru A399, how would I grab A3 thru C399
from Sheet1.

Please let me know. This is put a full stop to all the issues I've
been facing so far.

Thanks much,
Kevin.

On Oct 28, 9:45*pm, wrote:
On Oct 28, 8:35*pm, Per Jessen wrote:





Hi Kevin

Thanks for your reply.

I assume that you want to have data pasted to cell A1 and down on
sheets 0-29.
This should do it:

Sub Kevin()
Dim shCount As String
Sheets("Sheet1").Activate
Set found = Range("A1:A65536").Find(What:="performance",
After:=Range("A1"), LookIn:=xlValues, _
* * LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
* * MatchCase:=False)
If Not found Is Nothing Then
* * found.Resize(277, 1).Copy Destination:=Sheets("0").Range("A1")
* * fCell = found.Address
Else
* * msg = MsgBox("Performance was not found!", vbExclamation)
* * Exit Sub
End If
shCount = 1
Set Target = Sheets("Sheet1").Range(found.Address)
Do
* * Set found = Range("A1:A65536").FindNext(After:=Target)
* * If found.Address = fCell Then Exit Do
* * found.Resize(277, 1).Copy Destination:=Sheets(shCount).Range("A1")
* * shCount = shCount + 1
* * Set Target = Sheets("Sheet1").Range(found.Address)
Loop

End Sub

Regards,
Per

Thank you all. Per's code solved my problem.

I've generated 30 sheets in the same workbook. Existing code works by
copying and pasting the values in the adjacent columns (B, C etc...)
Instead of pasting in the adjacent columns, how do I need to tweak the
code to paste in the adjacent sheets? Please let me know...

Using the following code, I will have a master sheet named "Sheet1"
where this macro and the Per's macro will reside and 30 additional
sheets will be generated (named 0 thru 29)...

Dim count As Integer
For count = 1 To 30
Worksheets.Add after:=Sheets(Sheets.count)
Sheets(count + 1).Name = count - 1
Next count- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

Hi Per,

Yes, this code exactly does what I wanted.
Unfortunately, I found a glitch in my interpretation. The interval is
not always 276. Its sometimes 300+ and sometimes 240-ish...
I am now wondering how to tweak your macro to reflect this. Basically,
the algorithm would be to look for cell starting with "perform", in
this case its fCell; and look for the next cell starting containing
"perform", subtract -1 from the address and copy the range.

Considering the previous example, A6 will be the first location, A400
will be the second location, *so grab all values from A6 to A399, ...
and paste in the adjacent sheets (as done before)..

This should do the trick for me.

Per, I have couple more scenarios too but the previous one is of
primary importance.
1. In addition to grabbing A6 thru A399, how would I grab A3 thru
A399; the word "perform" still being in the cell A6
2. Instead of grabbing A6 thru A399, how would I grab A3 thru C399
from Sheet1.

Please let me know. This is put a full stop to all the issues I've
been facing so far.

Thanks much,
Kevin.- Hide quoted text -

- Show quoted text -

All, I've figured out that Resize(277, 3) grabs values from A thru C
cells. I am still stuck in getting the conditions explained in my
previous mail. Could anyone please help to solve this problem?
Per, any thoughts on this?
Thanks.

Hi again Kevin

It's a bit more complicated, but I think this should do it :


Sub Kevin()
Dim shCount As String
Sheets("Sheet1").Activate
Set found = Range("A1:A65536").Find(What:="performance",
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not found Is Nothing Then
Set target = Sheets("Sheet1").Range(found.Address)
Set found1 = Range("A1:A65536").FindNext(After:=target)
If found1.Address < found.Address Then
cSize = found1.Row - found.Row
found.Resize(cSize, 3).Copy
Destination:=Sheets("0").Range("A1")
fcell = found.Address
Else
cSize = target.End(xlDown).Row - found.Row + 1
found.Resize(cSize, 3).Copy
Destination:=Sheets("0").Range("A1")
Exit Sub
End If
Else
msg = MsgBox("Performance was not found!", vbExclamation)
Exit Sub
End If
shCount = 1
Set target = Sheets("Sheet1").Range(found.Address)
Do
Set found = Range("A1:A65536").FindNext(After:=target)
Set found1 =
Range("A1:A65536").FindNext(After:=Sheets("Sheet1" ).Range(found.Address))
If found1.Address = fcell Then
cSize = target.End(xlDown).Row - found.Row + 1
found.Resize(cSize, 3).Copy
Destination:=Sheets(shCount).Range("A1")
Exit Do
End If
cSize = found1.Row - found.Row
found.Resize(cSize, 3).Copy
Destination:=Sheets(shCount).Range("A1")
shCount = shCount + 1
Set target = Sheets("Sheet1").Range(found.Address)
Loop
End Sub

Best regards,
Per

On 29 Okt., 19:32, wrote:
On Oct 28, 9:45*pm, wrote:





On Oct 28, wrote:

Hi Kevin

Thanks for your reply.

I assume that you want to have data pasted to cell A1 and down on
sheets 0-29.
This should do it:

Sub Kevin()
Dim shCount As String
Sheets("Sheet1").Activate
Set found = Range("A1:A65536").Find(What:="performance",
After:=Range("A1"), LookIn:=xlValues, _
* * LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
* * MatchCase:=False)
If Not found Is Nothing Then
* * found.Resize(277, 1).Copy Destination:=Sheets("0").Range("A1")
* * fCell = found.Address
Else
* * msg = MsgBox("Performance was not found!", vbExclamation)
* * Exit Sub
End If
shCount = 1
Set Target = Sheets("Sheet1").Range(found.Address)
Do
* * Set found = Range("A1:A65536").FindNext(After:=Target)
* * If found.Address = fCell Then Exit Do
* * found.Resize(277, 1).Copy Destination:=Sheets(shCount).Range("A1")
* * shCount = shCount + 1
* * Set Target = Sheets("Sheet1").Range(found.Address)
Loop

End Sub

Regards,
Per

Thank you all.Per'scode solved my problem.

I've generated 30 sheets in the same workbook. Existing code works by
copying and pasting the values in the adjacent columns (B, C etc...)
Instead of pasting in the adjacent columns, how do I need to tweak the
code to paste in the adjacent sheets? Please let me know...

Using the following code, I will have a master sheet named "Sheet1"
where this macro and thePer'smacro will reside and 30 additional
sheets will be generated (named 0 thru 29)...

Dim count As Integer
For count = 1 To 30
Worksheets.Add after:=Sheets(Sheets.count)
Sheets(count + 1).Name = count - 1
Next count- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

HiPer,

Yes, this code exactly does what I wanted.
Unfortunately, I found a glitch in my interpretation. The interval is
not always 276. Its sometimes 300+ and sometimes 240-ish...
I am now wondering how to tweak your macro to reflect this. Basically,
the algorithm would be to look for cell starting with "perform", in
this case its fCell; and look for the next cell starting containing
"perform", subtract -1 from the address and copy the range.

Considering the previous example, A6 will be the first location, A400
will be the second location, *so grab all values from A6 to A399, ...
and paste in the adjacent sheets (as done before)..

This should do the trick for me.

Per, I have couple more scenarios too but the previous one is of
primary importance.
1. In addition to grabbing A6 thru A399, how would I grab A3 thru
A399; the word "perform" still being in the cell A6
2. Instead of grabbing A6 thru A399, how would I grab A3 thru C399
from Sheet1.

Please let me know. This is put a full stop to all the issues I've
been facing so far.

Thanks much,
Kevin.- Hide quoted text -

- Show quoted text -

All, I've figured out that Resize(277, 3) grabs values from A thru C
cells. I am still stuck in getting the conditions explained in my
previous mail. Could anyone please help to solve this problem?Per, any thoughts on this?
Thanks.- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -