C
Calop
Any help with this is greatly appreciated.
Bob was graceous enough to provide the vba script below, however I now need
to make a minor change in it. It extracts part of a string in column A1 and
puts the results after the last row in col B. I have approx 200 rows that do
the same extraction. I would like to have the results placed in G1 thru
however many rows. Each extraction goes on same row as it's orginal. I know
to change the B to G for the column, but don't know what to change to have
the extracted part go to G1 and so on, down the rows.
Thank you, Calop
Sub AREA_REPORT()
Dim oCell As Range
Dim tmp As String
Dim iRow As Long
Dim sFirst As String
Set oCell = Selection.Find("*-*(*")
If Not oCell Is Nothing Then
iRow = iRow + 1
Cells(iRow, "B").Value = CheckData(oCell)
sFirst = oCell.Address
Do
Set oCell = Selection.FindNext(oCell)
If Not oCell Is Nothing Then
If oCell.Address <> sFirst Then
iRow = iRow + 1
Cells(iRow, "B").Value = CheckData(oCell)
End If
End If
Loop While Not oCell Is Nothing And oCell.Address <> sFirst
End If
End Sub
Private Function CheckData(cell As Range)
Dim iPos1 As Long
Dim iPos2 As Long
iPos1 = InStr(cell.Value, "-")
iPos1 = InStr(iPos1 + 1, cell.Value, "-")
iPos2 = InStr(iPos2 + 1, cell.Value, "(")
CheckData = Left(cell.Value, iPos1 - 1) & _
Right(cell.Value, Len(cell.Value) - iPos2 + 1)
End Function
Bob was graceous enough to provide the vba script below, however I now need
to make a minor change in it. It extracts part of a string in column A1 and
puts the results after the last row in col B. I have approx 200 rows that do
the same extraction. I would like to have the results placed in G1 thru
however many rows. Each extraction goes on same row as it's orginal. I know
to change the B to G for the column, but don't know what to change to have
the extracted part go to G1 and so on, down the rows.
Thank you, Calop
Sub AREA_REPORT()
Dim oCell As Range
Dim tmp As String
Dim iRow As Long
Dim sFirst As String
Set oCell = Selection.Find("*-*(*")
If Not oCell Is Nothing Then
iRow = iRow + 1
Cells(iRow, "B").Value = CheckData(oCell)
sFirst = oCell.Address
Do
Set oCell = Selection.FindNext(oCell)
If Not oCell Is Nothing Then
If oCell.Address <> sFirst Then
iRow = iRow + 1
Cells(iRow, "B").Value = CheckData(oCell)
End If
End If
Loop While Not oCell Is Nothing And oCell.Address <> sFirst
End If
End Sub
Private Function CheckData(cell As Range)
Dim iPos1 As Long
Dim iPos2 As Long
iPos1 = InStr(cell.Value, "-")
iPos1 = InStr(iPos1 + 1, cell.Value, "-")
iPos2 = InStr(iPos2 + 1, cell.Value, "(")
CheckData = Left(cell.Value, iPos1 - 1) & _
Right(cell.Value, Len(cell.Value) - iPos2 + 1)
End Function