Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Loop help
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5
Default Loop help
Hi All,

Can you help me turn this into a loop/iteration macro? The macro
takes the value in AA2 and AB2 and concatenates them (with a charater
return) while preserving rich text formatting from the source cells
and places the result into AC2. I need this macro to then do this
down the rest of my results (preferably just as far down as their are
results in Column G). Any help would be greatly appreciated.

Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

Set SourceCells = Range("AA2:AB2")
Set DestRange = Range("AC2")

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1


With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next
DestChar = DestChar + Len(DELIM)

Next
End Sub

Thanks very much,
-David

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default Loop help
Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr


'Set SourceCells = Range("AA2:AB2")
'Set DestRange = Range("AC2")

set r1 = Range(Range("G2"),Range("G2").End(xldown))
for each cell1 in r1
Set SourceCells =Cells(cell1.row,"AA").Resize(1,2)
Set DestRange = SourceCells.(1,3)(1)

DestRange.ClearContents


'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1


With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next SourceChar
DestChar = DestChar + Len(DELIM)

Next cell
Next cell1
End Sub


--
Regards,
Tom Ogilvy



" wrote:

Hi All,

Can you help me turn this into a loop/iteration macro? The macro
takes the value in AA2 and AB2 and concatenates them (with a charater
return) while preserving rich text formatting from the source cells
and places the result into AC2. I need this macro to then do this
down the rest of my results (preferably just as far down as their are
results in Column G). Any help would be greatly appreciated.

Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

Set SourceCells = Range("AA2:AB2")
Set DestRange = Range("AC2")

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1


With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next
DestChar = DestChar + Len(DELIM)

Next
End Sub

Thanks very much,
-David


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5
Default Loop help

Thanks Tom, I was getting a Syntax Error at

Set DestRange = SourceCells.(1,3)(1)

I took a guess and changed this to "Set DestRange = SourceCells(1,3)
(1)", now the macro appropiately concatenates the two columns and
includes the character return, but it only preserves the rich text
formatting for the first cell (AC2). In my spreadsheet, Column AA has
Bold text, Column AB has normal text. Can you see where I've gone
wrong here? Thanks,

-David


On Aug 3, 3:48 pm, Tom Ogilvy
wrote:
Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

'Set SourceCells = Range("AA2:AB2")
'Set DestRange = Range("AC2")

set r1 = Range(Range("G2"),Range("G2").End(xldown))
for each cell1 in r1
Set SourceCells =Cells(cell1.row,"AA").Resize(1,2)
Set DestRange = SourceCells.(1,3)(1)

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1

With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next SourceChar
DestChar = DestChar + Len(DELIM)

Next cell
Next cell1
End Sub

--
Regards,
Tom Ogilvy



" wrote:
Hi All,

Can you help me turn this into a loop/iteration macro? The macro
takes the value in AA2 and AB2 and concatenates them (with a charater
return) while preserving rich text formatting from the source cells
and places the result into AC2. I need this macro to then do this
down the rest of my results (preferably just as far down as their are
results in Column G). Any help would be greatly appreciated.

Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

Set SourceCells = Range("AA2:AB2")
Set DestRange = Range("AC2")

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1

With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next
DestChar = DestChar + Len(DELIM)

Next
End Sub

Thanks very much,
-David- Hide quoted text -

- Show quoted text -

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default Loop help
Yes you caught my typo. Try it this way - worked for me with the situation
you described:

Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr


'Set SourceCells = Range("AA2:AB2")
'Set DestRange = Range("AC2")

Set r1 = Range(Range("G2"), Range("G2").End(xlDown))
For Each cell1 In r1
Set SourceCells = Cells(cell1.Row, "AA").Resize(1, 2)
Set DestRange = SourceCells(1, 3)(1)

DestRange.ClearContents


'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
DestChar = 0 ' added line to reinitialize DestChar on each loop
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1


With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next SourceChar
DestChar = DestChar + Len(DELIM)

Next Cell
Next cell1
End Sub

--
Regards,
Tom Ogilvy


" wrote:


Thanks Tom, I was getting a Syntax Error at

Set DestRange = SourceCells.(1,3)(1)

I took a guess and changed this to "Set DestRange = SourceCells(1,3)
(1)", now the macro appropiately concatenates the two columns and
includes the character return, but it only preserves the rich text
formatting for the first cell (AC2). In my spreadsheet, Column AA has
Bold text, Column AB has normal text. Can you see where I've gone
wrong here? Thanks,

-David


On Aug 3, 3:48 pm, Tom Ogilvy
wrote:
Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

'Set SourceCells = Range("AA2:AB2")
'Set DestRange = Range("AC2")

set r1 = Range(Range("G2"),Range("G2").End(xldown))
for each cell1 in r1
Set SourceCells =Cells(cell1.row,"AA").Resize(1,2)
Set DestRange = SourceCells.(1,3)(1)

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1

With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next SourceChar
DestChar = DestChar + Len(DELIM)

Next cell
Next cell1
End Sub

--
Regards,
Tom Ogilvy



" wrote:
Hi All,

Can you help me turn this into a loop/iteration macro? The macro
takes the value in AA2 and AB2 and concatenates them (with a charater
return) while preserving rich text formatting from the source cells
and places the result into AC2. I need this macro to then do this
down the rest of my results (preferably just as far down as their are
results in Column G). Any help would be greatly appreciated.

Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

Set SourceCells = Range("AA2:AB2")
Set DestRange = Range("AC2")

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1

With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next
DestChar = DestChar + Len(DELIM)

Next
End Sub

Thanks very much,
-David- Hide quoted text -

- Show quoted text -


Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5
Default Loop help
Perfect. Works like magic. Thanks very much for this.

-David

On Aug 3, 4:26 pm, Tom Ogilvy
wrote:
Yes you caught my typo. Try it this way - worked for me with the situation
you described:

Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

'Set SourceCells = Range("AA2:AB2")
'Set DestRange = Range("AC2")

Set r1 = Range(Range("G2"), Range("G2").End(xlDown))
For Each cell1 In r1
Set SourceCells = Cells(cell1.Row, "AA").Resize(1, 2)
Set DestRange = SourceCells(1, 3)(1)

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
DestChar = 0 ' added line to reinitialize DestChar on each loop
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1

With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next SourceChar
DestChar = DestChar + Len(DELIM)

Next Cell
Next cell1
End Sub

--
Regards,
Tom Ogilvy



" wrote:

Thanks Tom, I was getting a Syntax Error at

Set DestRange = SourceCells.(1,3)(1)

I took a guess and changed this to "Set DestRange = SourceCells(1,3)
(1)", now the macro appropiately concatenates the two columns and
includes the character return, but it only preserves the rich text
formatting for the first cell (AC2). In my spreadsheet, Column AA has
Bold text, Column AB has normal text. Can you see where I've gone
wrong here? Thanks,

-David

On Aug 3, 3:48 pm, Tom Ogilvy
wrote:
Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

'Set SourceCells = Range("AA2:AB2")
'Set DestRange = Range("AC2")

set r1 = Range(Range("G2"),Range("G2").End(xldown))
for each cell1 in r1
Set SourceCells =Cells(cell1.row,"AA").Resize(1,2)
Set DestRange = SourceCells.(1,3)(1)

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1

With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next SourceChar
DestChar = DestChar + Len(DELIM)

Next cell
Next cell1
End Sub

--
Regards,
Tom Ogilvy

" wrote:
Hi All,

Can you help me turn this into a loop/iteration macro? The macro
takes the value in AA2 and AB2 and concatenates them (with a charater
return) while preserving rich text formatting from the source cells
and places the result into AC2. I need this macro to then do this
down the rest of my results (preferably just as far down as their are
results in Column G). Any help would be greatly appreciated.

Sub PreserveRichText()

Dim SourceCells As Range
Dim DestRange As Range
Dim Cell As Range
Dim SourceChar As Long
Dim DestChar As Long
Dim SourceFont As Font
Const DELIM As String = vbCr

Set SourceCells = Range("AA2:AB2")
Set DestRange = Range("AC2")

DestRange.ClearContents

'Build the string first
For Each Cell In SourceCells
DestRange.Value = DestRange.Value & DELIM & Cell.Value
Next

DestRange.Value = Mid(DestRange.Value, Len(DELIM) + 1)

'Now process each Char
For Each Cell In SourceCells
For SourceChar = 1 To Cell.Characters.Count
Set SourceFont = Cell.Characters(SourceChar, 1).Font
DestChar = DestChar + 1

With DestRange.Characters(DestChar, 1).Font
.Bold = SourceFont.Bold
.ColorIndex = SourceFont.ColorIndex
.FontStyle = SourceFont.FontStyle
.Name = SourceFont.Name
.Size = SourceFont.Size
.Underline = SourceFont.Underline
' Other properties ?
End With
Next
DestChar = DestChar + Len(DELIM)

Next
End Sub

Thanks very much,
-David- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Naming Worksheets - Loop within a loop issue klysell Excel Programming 5 March 29th 07 05:48 AM
Naming Worksheets - Loop within a loop issue klysell Excel Programming 0 March 27th 07 11:17 PM
(Complex) Loop within loop to create worksheets klysell Excel Programming 1 March 20th 07 12:03 AM
Advancing outer Loop Based on criteria of inner loop ExcelMonkey Excel Programming 1 August 15th 05 05:23 PM
Problem adding charts using Do-Loop Until loop Chris Bromley[_2_] Excel Programming 2 May 23rd 05 01:31 PM


All times are GMT +1. The time now is 01:43 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement