View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Scoops Scoops is offline
external usenet poster
 
Posts: 108
Default Relacing partial text strings

On 16 May, 13:05, wrote:
I am trying to put together a macro to run behind a worksheet that
will preform the following procedures:

IF column B contains "PRO", "NOP" or "VAL" at the end of a text string
(eg. 2007/4/SH4A/90507/PRO) and Column CW =1, then copy the row to the
next availble row down and replace "PRO" with "CONP", "NOP" with
"CONN" and "VAL" with "CONV" in the target name (i.e. the pasted row).
Then go back and change the original copied names from "PRO" to
"VoidP", "NOP" to "VoidN" and "VAL" to "VoidV".

Im not sure of the best way to search and replace etxt strings in VB
and all attempts to date have been in vein.

Any advice on the best way of achieving this would be gratefully
appreciated.


Hi Jamie

Try this:

Sub TextReplace()
Dim SrcCell As Range
Dim DstCell As Range
For Each SrcCell In Range(Cells(1, "B"), Cells(Cells(Rows.Count,
2).End(xlUp).Row, 2))
If Cells(SrcCell.Row, "CW").Value = 1 Then
Select Case Right(SrcCell, 3)
Case "PRO"
Set DstCell = Cells(Rows.Count, 2).End(xlUp)(2)
SrcCell.EntireRow.Copy Cells(DstCell.Row, 1)
DstCell = Left(SrcCell, Len(SrcCell) - 3) & "CONP"
SrcCell = Left(SrcCell, Len(SrcCell) - 3) &
"VoidP"
Case "NOP"
Set DstCell = Cells(Rows.Count, 2).End(xlUp)(2)
SrcCell.EntireRow.Copy Cells(DstCell.Row, 1)
DstCell = Left(SrcCell, Len(SrcCell) - 3) & "CONN"
SrcCell = Left(SrcCell, Len(SrcCell) - 3) &
"VoidN"
Case "VAL"
Set DstCell = Cells(Rows.Count, 2).End(xlUp)(2)
SrcCell.EntireRow.Copy Cells(DstCell.Row, 1)
DstCell = Left(SrcCell, Len(SrcCell) - 3) & "CONV"
SrcCell = Left(SrcCell, Len(SrcCell) - 3) &
"VoidV"
End Select
End If
Next
End Sub

Regards

Steve