Concatenate Text Strings Across Worksheets HELP

[bbruner76132]

This seems like it should be easy, but has become quite a pain!

I have 20 worksheets (H1-H20), which are used by auditors to review patient records. Compliance is tracked on a simple binary system 1=met, 2=not met. The total met/not met are combined on a master sheet (HCS TOTALS), which is identical to each H1-H20 worksheet. That was the easy part.

However, there are several merged cells where the auditor is able to make comments. I have used the following formula to concatenate all comments to the corresponding comment cell on HCS TOTALS:

=CONCATENATE('H1'!AJ15:AR17,CHAR(10),CHAR(10),'H2'!AJ15:AR17,CHAR(10),CHAR(10),'H3'!AJ15:AR17,CHAR(10),CHAR(10),'H4'!AJ15:AR17,CHAR(10),CHAR(10),'H5'!AJ15:AR17,CHAR(10),CHAR(10), 'H6'!AJ15:AR17,CHAR(10),CHAR(10),'H7'!AJ15:AR17,CHAR(10),CHAR(10),'H8'!AJ15:AR17,CHAR(10),CHAR(10),'H9'!AJ15:AR17,CHAR(10),CHAR(10),'H10'!AJ15:AR17,CHAR(10),CHAR(10), 'H11'!AJ15:AR17,CHAR(10),CHAR(10),'H12'!AJ15:AR17,CHAR(10),CHAR(10),'H13'!AJ15:AR17,CHAR(10),CHAR(10),'H14'!AJ15:AR17,CHAR(10),CHAR(10),'H15'!AJ15:AR17,CHAR(10),CHAR(10), 'H16'!AJ15:AR17,CHAR(10),CHAR(10),'H17'!AJ15:AR17,CHAR(10),CHAR(10),'H18'!AJ15:AR17,CHAR(10),CHAR(10),'H19'!AJ15:AR17,CHAR(10),CHAR(10),'H20'!AJ15:AR17,CHAR(10))

The formula works, but there are two problems: (1) the formula does not skip blank cells and (2) the merge cell does not auto-resize to fit the contents.

I am using the following macro to manually resize the comment section:

Sub AutoFitMergedCellRowHeight()
Dim MergedHeight As Single
Dim MergedWidth As Single
Dim PossNewRowHeight As Single
Dim lngRowCount As Long
Dim lngColCount As Long
Dim i As Long
Dim ActiveCellWidth As Single
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .WrapText = True Then
lngRowCount = .Rows.Count
lngColCount = .Columns.Count
Application.ScreenUpdating = False
MergedHeight = Selection.Height
For i = 1 To lngColCount
MergedWidth = .Cells(1, i).ColumnWidth + 1 + MergedWidth
Next i
ActiveCellWidth = ActiveCell.ColumnWidth
.MergeCells = False
.Cells(1).RowHeight = MergedHeight
.Cells(1).ColumnWidth = MergedWidth
.EntireRow.AutoFit
PossNewRowHeight = .Cells(1).RowHeight
.MergeCells = True
.Cells(1).ColumnWidth = ActiveCellWidth
For i = 1 To lngRowCount
.Cells(i, 1).RowHeight = PossNewRowHeight / lngRowCount
Next i
End If
End With
End If
End Sub

Is there a way to only populate comments on HCS Totals as it is typed and make the above macro automatic?! Help me pleeeease

[MarvinP]

Hi bbruner and welcome to the forum,

First your Char(10),Char(10) in the Concatinate function can be replaced with Rept(Char(10),2).
That might make your long formula a little simpler.

BUT - we really need to see a sample of your workbook to do a better job with this answer.
You can attach a sample workbook by clicking on "Go Advanced" and then on the Paper Clip Icon above the advanced message area.

ALSO - the forum moderator will give you a demerit if you don't edit your above post and put the code in code brackets. To do this, edit your post, select the VBA code and then click on the # icon above the message area. This will put "Code" tags around your code and you'll be safe.