I have an Excel 2010 workbook with multiple worksheets.

Worksheet 'one' has column B holding values such as ',1,12,20,'
(starting at row 2) with adjacent cells in column C holding textual
comments relating to the entries in column B.

I need to search through column B and find the first cell holding ',1,'
and then copy the adjacent cell in column C to column D in worksheet
'two'. The search then needs to continue to find the next occurrence of
',1,' in B and copy the corresponding cell in column C to the next row
in column D of worksheet 'two'.

Some of the cells in column B of worksheet 'one' do not hold ',1,' so I
would prefer it if they did not provoke blank rows in worksheet 'two'.

Any help would be gratefully received!

TIA

--
F

Hi,

Am Wed, 24 Apr 2013 20:45:20 +0100 schrieb F:

I need to search through column B and find the first cell holding ',1,'
and then copy the adjacent cell in column C to column D in worksheet
'two'. The search then needs to continue to find the next occurrence of
',1,' in B and copy the corresponding cell in column C to the next row
in column D of worksheet 'two'.

try (modify to suit):

Sub myCopy()
Dim LRow As Long
Dim rngC As Range
Dim i As Long

i = 2
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For Each rngC In .Range("B2:B" & LRow)
If InStr(rngC, ",1,") 0 Then
Sheets("Sheet2").Cells(i, 4) = rngC.Offset(0, 1)
i = i + 1
End If
Next
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On 24/04/2013 21:19 Claus Busch wrote:

Hi,

Am Wed, 24 Apr 2013 20:45:20 +0100 schrieb F:

I need to search through column B and find the first cell holding ',1,'
and then copy the adjacent cell in column C to column D in worksheet
'two'. The search then needs to continue to find the next occurrence of
',1,' in B and copy the corresponding cell in column C to the next row
in column D of worksheet 'two'.

try (modify to suit):

Sub myCopy()
Dim LRow As Long
Dim rngC As Range
Dim i As Long

i = 2
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For Each rngC In .Range("B2:B" & LRow)
If InStr(rngC, ",1,") 0 Then
Sheets("Sheet2").Cells(i, 4) = rngC.Offset(0, 1)
i = i + 1
End If
Next
End With
End Sub


Regards
Claus Busch

Amazing, and such a speedy response. Thank you!!

Can I ask for an enhancement? Is it possible to avoid copying the cell
in column C if it is blank?

--
F

Hi,

Am Wed, 24 Apr 2013 21:35:39 +0100 schrieb F:

Can I ask for an enhancement? Is it possible to avoid copying the cell
in column C if it is blank?

change the IF-statement:

If InStr(rngC, ",1,") 0 And Len(rngC.Offset(0, 1)) 0 Then
Sheets("Sheet2").Cells(i, 4) = rngC.Offset(0, 1)
i = i + 1
End If


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On 24/04/2013 21:44 Claus Busch wrote:

Hi,

Am Wed, 24 Apr 2013 21:35:39 +0100 schrieb F:

Can I ask for an enhancement? Is it possible to avoid copying the cell
in column C if it is blank?

change the IF-statement:

If InStr(rngC, ",1,") 0 And Len(rngC.Offset(0, 1)) 0 Then
Sheets("Sheet2").Cells(i, 4) = rngC.Offset(0, 1)
i = i + 1
End If


Regards
Claus Busch

Perfect. Thank you again: much appreciated!

--
F