Concatenate Text Strings from Single Cells of Variable number of Worksheets

[Pitmo]

Hello, Similar to the request below:

https://www.mrexcel.com/forum/excel...enate-single-cell-variable-number-sheets.html

I need to concatenate/combine text stings from a variable number of worksheets into a single cell, with each result separated by a line feed. I'd like to ignore worksheets that have no results.

To explain the layout:
I have three worksheets within the workbook that are out of scope.
I have one 'Results' worksheet and multiple 'Survey Response' worksheets which can range from one to 30+. The 'Survey Response' worksheets are all set within two hidden 'bookends' named 'Start' and 'End'.

I need to compile text found in 'E4' on the 'Survey Response' worksheets into 'E5' on the 'Results' worksheet. With each string of text separated by a line feed.

There are 30 or so more repetitions of this.

e.g. 'E5' on the 'Survey Response' worksheets to 'E6' on the 'Results'
'E7' on the 'Survey Response' worksheets to 'E8' on the 'Results'and so on.

Assume this needs to be VB as my concatenate formula only works for a fixed number of worksheets.

Thanks
Pitmo

 

[bhos123]

'This will concatenate E4s from survey response worksheets to E5 on Results worksheet.

Sub Macro2()
Dim x1 As Long
Dim x2 As Long
Dim s As Long
s = 0
For Each ws In ActiveWorkbook.Sheets
s = s + 1
If ws.Name = "Start" Then x1 = s + 1
If ws.Name = "End" Then x2 = s - 1
Next
For i = x1 To x2


Sheets("Results").Cells(5, 5).Value = Sheets("Results").Cells(5, 5).Value & "_" & Sheets(i).Cells(4, 5).Value


Next
Sheets("Results").Cells(5, 5).Value = WorksheetFunction.Replace(Sheets("Results").Cells(5, 5).Value, 1, 1, "")


End Sub

 

[Pitmo]

Thanks bhos123, that's a good start.

That gets the text in and I've replaced

& "_" &

with

& vbCrLf &

to get a line feed.

If I want to repeat the task for 'E7' to 'E8' etc. is that simple enough to copy and paste down?

Pitmo

 

[Pitmo]

OK, so I have just copied and pasted the four lines of code, multiple times, changing the cell references, I'm sure there must be a better way but I'm a novice at VBA:

[COLOR=#574123]For i = x1 To x2[/COLOR]
[COLOR=#574123]Sheets("Results").Cells(5, 5).Value = Sheets("Results").Cells(5, 5).Value & "_" & Sheets(i).Cells(4, 5).Value[/COLOR]
[COLOR=#574123]Next[/COLOR]
[COLOR=#574123]Sheets("Results").Cells(5, 5).Value = WorksheetFunction.Replace(Sheets("Results").Cells(5, 5).Value, 1, 1, "")[/COLOR]

[COLOR=#574123]For i = x1 To x2[/COLOR]

[COLOR=#574123]Sheets("Results").Cells(6, 5).Value = Sheets("Results").Cells(6, 5).Value & "_" & Sheets(i).Cells(5, 5).Value[/COLOR]

[COLOR=#574123]Next[/COLOR]
[COLOR=#574123]Sheets("Results").Cells(6, 5).Value = WorksheetFunction.Replace(Sheets("Results").Cells(6, 5).Value, 1, 1, "")[/COLOR]

I still need to ignore the cell if it is blank otherwise I end up with loads of carriage returns and white space.

Can anyone suggest how to adapt the code to ignore blank cells?

Thanks in advance...

Pitmo

 

[Pitmo]

Sorry code not quote right:

OK, so I have just copied and pasted the four lines of code, multiple times, changing the cell references, I'm sure there must be a better way but I'm a novice at <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym>:Code:
For i = x1 To x2
Sheets("Results").Cells(5, 5).Value = Sheets("Results").Cells(5, 5).Value & vbCrLf & Sheets(i).Cells(4, 5).Value
Next
Sheets("Results").Cells(5, 5).Value = WorksheetFunction.Replace(Sheets("Results").Cells(5, 5).Value, 1, 1, "")

For i = x1 To x2

Sheets("Results").Cells(6, 5).Value = Sheets("Results").Cells(6, 5).Value & vbCrLf & Sheets(i).Cells(5, 5).Value

Next
Sheets("Results").Cells(6, 5).Value = WorksheetFunction.Replace(Sheets("Results").Cells(6, 5).Value, 1, 1, "")
I still need to ignore the cell if it is blank otherwise I end up with loads of carriage returns and white space.

Can anyone suggest how to adapt the code to ignore blank cells?

Thanks in advance...

Pitmo

 

[Pitmo]

My question, is better asked here:

https://www.mrexcel.com/forum/excel...concatenating-data-one-worksheet-another.html

 

[bhos123]

'This will concatenate E4s - E7s from survey response worksheets to E5s - E8s on Results worksheet.


Sub Macro2()
Dim x1 As Long
Dim x2 As Long
Dim s As Long
s = 0
For Each ws In ActiveWorkbook.Sheets
s = s + 1
If ws.Name = "Start" Then x1 = s + 1
If ws.Name = "End" Then x2 = s - 1
Next
For j = 4 To 7
For i = x1 To x2
Sheets("Results").Cells(j+1, 5).Value = Sheets("Results").Cells(j+1, 5).Value & vbCrLf & Sheets(i).Cells(j, 5).Value
Next
Sheets("Results").Cells(j+1, 5).Value = WorksheetFunction.Replace(Sheets("Results").Cells(j+1, 5).Value, 1, 1, "")
Next
End Sub

 

[Pitmo]

Thanks, but I'm getting - Compile Error: For without Next.

When I add 'Next between the 'For' entries it then runs but not correctly. In that it adds the data to row 9 on the "Results".

[/I][COLOR=#333333]For j = 4 To 7[/COLOR]
[COLOR=#333333]For i = x1 To x2[/COLOR][I]

Do you have a way to ignore the blank cells too?

 

[bhos123]

It's working perfectly for me, not sure why you are getting errors. do you have worksheets named, "Start" , "End" and "Results" .

Regarding missing part, use the below code.

Sub Macro2()
Dim x1 As Long
Dim x2 As Long
Dim s As Long
s = 0
For Each ws In ActiveWorkbook.Sheets
s = s + 1
If ws.Name = "Start" Then x1 = s + 1
If ws.Name = "End" Then x2 = s - 1
Next
For j = 4 To 7
For i = x1 To x2
If Sheets(i).Cells(j, 5).Value <> "" Then
If i = x1 Then
Sheets("Results").Cells(j + 1, 5).Value = Sheets(i).Cells(j, 5).Value
Else
Sheets("Results").Cells(j + 1, 5).Value = Sheets("Results").Cells(j + 1, 5).Value & vbCrLf & Sheets(i).Cells(j, 5).Value
End If
End If
Next
Next
End Sub

 

[Pitmo]

Great - that is working now - many thanks for your time