I am working on a spreadsheet to produce a markup (redline/strikeout) version based on the output of the Microsoft Spreadsheet Comparison tool. The following code loop is supposed to take the formatted text content of one cell (red text with strikeouts), add a CHR(010), and then append the content of a second cell (red text no strikeout) to it creating a third cell containing one formatted text string. The cell is then copied back to the modified cell in the original spreadsheet. The program works well except that, once the length of the text string being built reaches 256 characters, new characters are not added. The loop does not error out (my first example attached should build a string 500+ characters long) but only 255 characters are displayed and a LEN() on the output cell says the length = 255.
Function Redline1(d)
d.Font.Color = RGB(255, 0, 0)
d.Font.Strikethrough = True
'Response = MsgBox(d, vbOKCancel)
End Function
Function Redline2(d)
d.Font.Color = RGB(255, 0, 0)
d.Font.Strikethrough = False
'Response = MsgBox(d, vbOKCancel)
End Function
Function Combine(CellsToConcat, outcell)
Dim X As Long, P As Long, Cell As Range, f As Font
P = 1
outcell.Characters(P, 1).Text = Chr(10)
For Each Cell In CellsToConcat
For X = 1 To Len(Cell.Value)
P = P + 1
outcell.Characters(P, 1).Text = Cell.Characters(X, 1).Text
outcell.Characters(P, 1).Font.Color = Cell.Characters(X, 1).Font.Color
outcell.Characters(P, 1).Font.Strikethrough = Cell.Characters(X, 1).Font.Strikethrough
Next
P = P + 1
outcell.Characters(P, 1).Text = Chr(10)
Next
End Function
Sub Loop_Deltas()
Dim Response, lastCell, firstCell, newcell, targetSheet, targetCell, oldValue, newValue, fullValue
Worksheets("Differences").Activate
firstCell = InputBox("What is the first cell")
lastCell = InputBox("What is the last cell")
For Each c In Worksheets("Differences").Range(firstCell, lastCell)
c.Activate
If c.Offset(0, 4) Like "Entered*" Then
targetSheet = c.Value
targetCell = c.Offset(0, 1).Value
oldValue = Redline1(c.Offset(0, 2))
newValue = Redline2(c.Offset(0, 3))
fullValue = Combine(Range(c.Offset(0, 2), c.Offset(0, 3)), c.Offset(0, 5))
If Worksheets(targetSheet).Range(targetCell).MergeCells Then
Worksheets(targetSheet).Range(targetCell).MergeArea.UnMerge
End If
c.Offset(0, 5).Borders.LineStyle = xlContinuous
c.Offset(0, 5).Interior.Color = Worksheets(targetSheet).Range(targetCell).Interior.Color
c.Offset(0, 5).Copy Worksheets(targetSheet).Range(targetCell)
Worksheets(targetSheet).Range(targetCell).WrapText = True
Worksheets(targetSheet).Range(targetCell).HorizontalAlignment = xlLeft
Worksheets(targetSheet).Range(targetCell).VerticalAlignment = xlCenter
Worksheets(targetSheet).Range(targetCell).EntireRow.AutoFit
End If
Next
End Sub
When Loop_Deltas is run with First Cell and Last Cell set to 'A2' for the single input row listed below, the output is as follows (Note: Old Value, New Value, and Result in the output are all properly colored RED in the actual spreadsheet.
Input:
Output:
Function Redline1(d)
d.Font.Color = RGB(255, 0, 0)
d.Font.Strikethrough = True
'Response = MsgBox(d, vbOKCancel)
End Function
Function Redline2(d)
d.Font.Color = RGB(255, 0, 0)
d.Font.Strikethrough = False
'Response = MsgBox(d, vbOKCancel)
End Function
Function Combine(CellsToConcat, outcell)
Dim X As Long, P As Long, Cell As Range, f As Font
P = 1
outcell.Characters(P, 1).Text = Chr(10)
For Each Cell In CellsToConcat
For X = 1 To Len(Cell.Value)
P = P + 1
outcell.Characters(P, 1).Text = Cell.Characters(X, 1).Text
outcell.Characters(P, 1).Font.Color = Cell.Characters(X, 1).Font.Color
outcell.Characters(P, 1).Font.Strikethrough = Cell.Characters(X, 1).Font.Strikethrough
Next
P = P + 1
outcell.Characters(P, 1).Text = Chr(10)
Next
End Function
Sub Loop_Deltas()
Dim Response, lastCell, firstCell, newcell, targetSheet, targetCell, oldValue, newValue, fullValue
Worksheets("Differences").Activate
firstCell = InputBox("What is the first cell")
lastCell = InputBox("What is the last cell")
For Each c In Worksheets("Differences").Range(firstCell, lastCell)
c.Activate
If c.Offset(0, 4) Like "Entered*" Then
targetSheet = c.Value
targetCell = c.Offset(0, 1).Value
oldValue = Redline1(c.Offset(0, 2))
newValue = Redline2(c.Offset(0, 3))
fullValue = Combine(Range(c.Offset(0, 2), c.Offset(0, 3)), c.Offset(0, 5))
If Worksheets(targetSheet).Range(targetCell).MergeCells Then
Worksheets(targetSheet).Range(targetCell).MergeArea.UnMerge
End If
c.Offset(0, 5).Borders.LineStyle = xlContinuous
c.Offset(0, 5).Interior.Color = Worksheets(targetSheet).Range(targetCell).Interior.Color
c.Offset(0, 5).Copy Worksheets(targetSheet).Range(targetCell)
Worksheets(targetSheet).Range(targetCell).WrapText = True
Worksheets(targetSheet).Range(targetCell).HorizontalAlignment = xlLeft
Worksheets(targetSheet).Range(targetCell).VerticalAlignment = xlCenter
Worksheets(targetSheet).Range(targetCell).EntireRow.AutoFit
End If
Next
End Sub
When Loop_Deltas is run with First Cell and Last Cell set to 'A2' for the single input row listed below, the output is as follows (Note: Old Value, New Value, and Result in the output are all properly colored RED in the actual spreadsheet.
Input:
Sheet | Range | Old Value | New Value | Description | Result | Length of Result | length of source |
ZPC 12.935-C | V19 | TR-1776, ATS 5000 Feature Attribute Analysis. Usability Design Validation Under Simulated Use Conditions [UEF185_181 Form ZPC 1.801_F HFE_UE Report] Form ZPC 12.900/I, ATS 5000 Verification/Validation Report Summary BRMF #151 Completed ES132 for Components | BRMF #151 Completed ES132 for Components Form ZPC 12.900/I, ATS 5000 Verification/Validation Report Summary TR-1776, ATS 5000 Feature Attribute Analysis. Usability Design Validation Under Simulated Use Conditions [UEF185_181 Form ZPC 1.801_F HFE_UE Report] | Entered Value Changed. | 0 | 523 |
Output:
Sheet | Range | Old Value | New Value | Description | Result | Length of Result | length of source |
ZPC 12.935-C | V19 | BRMF #151 Completed ES132 for Components Form ZPC 12.900/I, ATS 5000 Verification/Validation Report Summary TR-1776, ATS 5000 Feature Attribute Analysis. Usability Design Validation Under Simulated Use Conditions [UEF185_181 Form ZPC 1.801_F HFE_UE Report] | Entered Value Changed. | 255 | 523 |