Many thanks for that. It did the trick. Didn't know
the WrapText problem would prove this difficult,
(I couldn't get my original suggestion to work at all)
nevertheless have developed the following routine:
Sub ConvertToWrapText()
Dim c As Range, StartCopyRow As Long, EndCopyRow As Long
Dim dataStr As Variant, StartRw As Long, EndRw As Long
Dim rnght As Long, iCtr As Integer, d As Range, ws As Worksheet
Dim Transferdata As String, £col As Long, i As Integer
For Each ws In ActiveWorkbook.Worksheets()
For Each c In Range("A1:Z100")
If c.Value = "£" Then
£col = c.Column
Exit For
End If
Next
With ws
.Unprotect
StartRw = 2
EndRw = Range("B65536").End(xlUp).Row
For Each c In Range("A" & StartRw, "A" & EndRw)
If Not IsEmpty(c) Then
If Not (c.Offset(1, £col - 1).Value = "£" Or _
c.Offset(-1, £col - 1).Value = "£") Then
StartCopyRow = c.Row
iCtr = 1
Do
If Not IsEmpty(.Range("B" & StartCopyRow) _
.Offset(iCtr, 0)) Then
iCtr = iCtr + 1
Else
Exit Do
End If
Loop
If iCtr 1 Then 'must be a case for wraptext
EndCopyRow = .Range("B" & StartCopyRow) _
.Offset(iCtr - 1, 0).Row
ReDim dataStr(1 To iCtr)
For iCtr = 1 To iCtr
For Each d In Range("B" & StartCopyRow, _
"B" & EndCopyRow)
dataStr(iCtr) = d.Value
iCtr = iCtr + 1
Next
Next
.Rows(EndCopyRow + 1).EntireRow.Insert
.Range("B" & EndCopyRow + 1).WrapText = True
.Range("A" & StartCopyRow, "G" & StartCopyRow).Copy
.Range("A" & EndCopyRow + 1).PasteSpecial xlPasteValues
.Range("A" & StartCopyRow, "G" & EndCopyRow) _
.EntireRow.Delete
For i = 1 To UBound(dataStr)
If i = 1 Then
Transferdata = dataStr(i)
Else
Transferdata = Transferdata & " " & dataStr(i)
End If
Next
.Range("B" & StartCopyRow).Value = Transferdata
End If
Else
GoTo Line100
End If
End If
Line100:
Next
.Columns("A:G").VerticalAlignment = xlTop
.Columns("B:B").WrapText = True
Range("A1").Select
End With
Next
End Sub
The code appeared to run ok through the first sheet, but in sheet 2
I noticed problems. It seemed that wraptext was not enabled (the
text in the cell appeared to have been clipped). So I ran it through
sheet 1 to a breakpoint, then stepped through sheet 2.
The array correctly held the original cell's text entry, and after
pasting, the cell had not wrapped, but the formula bar held the
full text entry. I carried on stepping to the end of the sheet. The
cell had still not wrapped and now the formula bar only showed
text equal to the 1st element in the array.
Can you explain what's happening, please?
Regards.
"Trevor Shuttleworth" wrote in message
...
Stuart
Lose the .value on the two lines
Dim dataStr(1 To 5)
dataStr(1) = "a"
dataStr(2) = "b"
dataStr(3) = "c"
dataStr(4) = "d"
dataStr(5) = "e"
For i = 1 To UBound(dataStr)
If i = 1 Then
Transferdata = dataStr(i)
Else
Transferdata = Transferdata & " " & dataStr(i)
End If
Next
MsgBox Transferdata
Regards
Trevor
"Stuart" wrote in message
...
Nearly there, I think.
I've built an array whereby the elements contain
the cell contents of B10 and B11, but cannot seem
to combine the elements back into a single string
Here is the code, which gives 'object required' on
the line......Transferdata etc (dimmed as string)
For i = 1 To UBound(dataStr)
If i = 1 Then
Transferdata = dataStr(i).Value
Else
Transferdata = Transferdata & " " & dataStr(i).Value
End If
Next
Tried using Join, but cannot make that work either.
Regards.
"Trevor Shuttleworth" wrote in message
...
Stuart
that would work. The only other suggestion would be to build the cell
in
a
variable, reformat the cell with Wrap Text and drop the contents of
the
variable into the cell. In your example, build the variable from the
contents of B5 to B8, reformat B5 with Wrap Text and copy the variable
contents to B5. Delete rows 6 to 8. As always, when you are deleting
rows
it's probably easiest to work up from the bottom of the data.
One concern would be that if the user had created "short" entries in
the
cells B5 to B8, when they are combined into one cell with Wrap Text
they
may
only generate 3 lines rather than the original 4 which could screw up
your
formatting. Just a thought. Maybe you need to include a new line
character
to force the same number of rows?
Regards
Trevor
"Stuart" wrote in message
...
Hit Send too early.
Meant to add that I was thinking of the following:
Establish the start and end row of a record (say the
record is "A5:G8")
Then insert a row into "A9" and format "B9" with
WrapText enabled.
Then copy the record into "A9" and delete "A5:G8".
A few rows short, but the wraptext will compensate
for that.
Is there a better way, please?
Regards.
"Stuart" wrote in message
...
I have a rogue user workbook ( a one-off, I hope)
such that current code will not run completely
successfully on it.
Rather than adapt the code for this one instance, I
wonder if there is a way to alter the data?
Row
1 A Data....................
2 Data......................
3 Data..........................
4
5 B Data..........................
Data....................................
What this user has done, is to type data into
individual rows in col B, rather than use wraptext.
What I'd like to do is to loop through the records
(there's always at least one empty row between
records) and change the data to the way it would
have been created with wraptext enabled in Col B.
Is that possible, please?
Regards.
---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.515 / Virus Database: 313 - Release Date: 01/09/2003
---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.515 / Virus Database: 313 - Release Date: 01/09/2003
---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.515 / Virus Database: 313 - Release Date: 01/09/2003
---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (
http://www.grisoft.com).
Version: 6.0.515 / Virus Database: 313 - Release Date: 01/09/2003