View Full Version : VBA: concatenate multiple cell data
Please help me to concatenate multiple cell data in output 1 and output2 exactly in the same way as it appears in the attached excel sheet.
I have thousands of row data.
Thanks in advance.
Paul_Hossler
03-12-2022, 05:35 PM
Easy enough but there are some questions about the logic
1. What's difference between Output1 and Output2?
I2 looks like it has data from Row2 and Row3 (Fridge2 and Fridge3??)
H3 only has data from Row3
2. Do you have blank rows (Row4)?
3. Row6 and Row7 have the same input data, but Row6 has an Output2, and Row7 does not
(I turned on Text Wrap so I could see it better)
29501
Edit --
Output1 is easy, although Col D requires some special handling
Option Explicit
Sub MakeSentences()
Dim Output1 As String, Output2 As String
Dim iCol As Long, iRow As Long, iLastRow As Long, i As Long
With Worksheets("Test")
iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For iRow = 2 To iLastRow
Output1 = vbNullString
Output2 = vbNullString
If Len(.Cells(iRow, 1).Value) > 0 Then Output1 = Output1 & .Cells(1, 1).Value & " " & .Cells(iRow, 1).Value & " "
If Len(.Cells(iRow, 2).Value) > 0 Then Output1 = Output1 & .Cells(1, 2).Value & " " & .Cells(iRow, 2).Value & " "
If Len(.Cells(iRow, 3).Value) > 0 Then Output1 = Output1 & .Cells(1, 3).Value & " " & .Cells(iRow, 3).Value & " "
If Len(.Cells(iRow, 4).Value) > 0 Then
i = InStrRev(.Cells(iRow, 4).Value, "=")
Output1 = Output1 & Left(.Cells(1, 4).Value, Len(.Cells(1, 4).Value) - 1) & " "
Output1 = Output1 & Right(.Cells(iRow, 4).Value, Len(.Cells(iRow, 4).Value) - i - 1) & " ) "
End If
If Len(.Cells(iRow, 5).Value) > 0 Then Output1 = Output1 & .Cells(1, 5).Value & " " & .Cells(iRow, 5).Value & " "
If Len(.Cells(iRow, 6).Value) > 0 Then Output1 = Output1 & .Cells(1, 6).Value & " " & .Cells(iRow, 6).Value & " "
If Len(.Cells(iRow, 7).Value) > 0 Then Output1 = Output1 & .Cells(1, 7).Value & " " & .Cells(iRow, 7).Value & " "
.Cells(iRow, 8).Value = Trim(Replace(Output1, " ", " "))
Next iRow
End With
End Sub
Answers are added below the questions. Please have a look.
Easy enough but there are some questions about the logic
1. What's difference between Output1 and Output2?
I2 looks like it has data from Row2 and Row3 (Fridge2 and Fridge3??)
H3 only has data from Row3
Colum A has same IDs based on which I have to get Row2 as shown, and Row3 is thus concatenated form of Row2 out of unique ID.
2. Do you have blank rows (Row4)?
Yes. They may appear below as well before last cell data.
3. Row6 and Row7 have the same input data, but Row6 has an Output2, and Row7 does not
Row6 and Row7 will give same Output1. And So in Output2 I expect only one output.
(I turned on Text Wrap so I could see it better)
29501
Edit --
Output1 is easy, although Col D requires some special handling
Option Explicit
Sub MakeSentences()
Dim Output1 As String, Output2 As String
Dim iCol As Long, iRow As Long, iLastRow As Long, i As Long
With Worksheets("Test")
iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For iRow = 2 To iLastRow
Output1 = vbNullString
Output2 = vbNullString
If Len(.Cells(iRow, 1).Value) > 0 Then Output1 = Output1 & .Cells(1, 1).Value & " " & .Cells(iRow, 1).Value & " "
If Len(.Cells(iRow, 2).Value) > 0 Then Output1 = Output1 & .Cells(1, 2).Value & " " & .Cells(iRow, 2).Value & " "
If Len(.Cells(iRow, 3).Value) > 0 Then Output1 = Output1 & .Cells(1, 3).Value & " " & .Cells(iRow, 3).Value & " "
If Len(.Cells(iRow, 4).Value) > 0 Then
i = InStrRev(.Cells(iRow, 4).Value, "=")
Output1 = Output1 & Left(.Cells(1, 4).Value, Len(.Cells(1, 4).Value) - 1) & " "
Output1 = Output1 & Right(.Cells(iRow, 4).Value, Len(.Cells(iRow, 4).Value) - i - 1) & " ) "
End If
If Len(.Cells(iRow, 5).Value) > 0 Then Output1 = Output1 & .Cells(1, 5).Value & " " & .Cells(iRow, 5).Value & " "
If Len(.Cells(iRow, 6).Value) > 0 Then Output1 = Output1 & .Cells(1, 6).Value & " " & .Cells(iRow, 6).Value & " "
If Len(.Cells(iRow, 7).Value) > 0 Then Output1 = Output1 & .Cells(1, 7).Value & " " & .Cells(iRow, 7).Value & " "
.Cells(iRow, 8).Value = Trim(Replace(Output1, " ", " "))
Next iRow
End With
End Sub
Paul_Hossler
03-13-2022, 06:59 AM
Added logic to handle special rules
Also added vbLf to make it easier for me to review - delete if you want
Option Explicit
Sub MakeSentences()
Dim Output1 As String, Output2 As String
Dim iCol As Long, iRow As Long, iLastRow As Long, i As Long, iFruitRow As Long
Dim collFruit As Collection, Fruit As Variant
Dim collOutput2 As Collection, Output2Line As Variant
With Worksheets("Test")
iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For iRow = 2 To iLastRow
Output1 = vbNullString
If Len(.Cells(iRow, 5).Value) = 0 And Len(.Cells(iRow, 6).Value) = 0 And Len(.Cells(iRow, 7).Value) = 0 Then
'The fruit
If Len(.Cells(iRow, 1).Value) > 0 Then Output1 = Output1 & .Cells(iRow, 1).Value & " "
'kept in the
If Len(.Cells(iRow, 3).Value) > 0 Then Output1 = Output1 & .Cells(1, 3).Value & " " & .Cells(iRow, 3).Value & " "
'(got Temperature: )
If Len(.Cells(iRow, 4).Value) > 0 Then
i = InStrRev(.Cells(iRow, 4).Value, "=")
Output1 = Output1 & Left(.Cells(1, 4).Value, Len(.Cells(1, 4).Value) - 1) & " "
Output1 = Output1 & Right(.Cells(iRow, 4).Value, Len(.Cells(iRow, 4).Value) - i - 1) & " ) "
End If
'Output1
.Cells(iRow, 8).Value = Trim(Replace(Output1, " ", " "))
Else
'The fruit
If Len(.Cells(iRow, 1).Value) > 0 Then Output1 = Output1 & .Cells(1, 1).Value & " " & .Cells(iRow, 1).Value & " "
'bought by
If Len(.Cells(iRow, 2).Value) > 0 Then Output1 = Output1 & .Cells(1, 2).Value & " " & .Cells(iRow, 2).Value & " "
'kept in the
If Len(.Cells(iRow, 3).Value) > 0 Then Output1 = Output1 & .Cells(1, 3).Value & " " & .Cells(iRow, 3).Value & " "
'(got Temperature: )
If Len(.Cells(iRow, 4).Value) > 0 Then
i = InStrRev(.Cells(iRow, 4).Value, "=")
Output1 = Output1 & Left(.Cells(1, 4).Value, Len(.Cells(1, 4).Value) - 1) & " "
Output1 = Output1 & Right(.Cells(iRow, 4).Value, Len(.Cells(iRow, 4).Value) - i - 1) & " ) "
End If
', and also got highest mark in
If Len(.Cells(iRow, 5).Value) > 0 Then Output1 = Output1 & .Cells(1, 5).Value & " " & .Cells(iRow, 5).Value & " "
', and also in
If Len(.Cells(iRow, 6).Value) > 0 Then Output1 = Output1 & .Cells(1, 6).Value & " " & .Cells(iRow, 6).Value & ". "
'They got gifts like
If Len(.Cells(iRow, 7).Value) > 0 Then
Output1 = Output1 & .Cells(iRow, 1).Value & " " & .Cells(1, 7).Value & " " & .Cells(iRow, 7).Value & " "
End If
'Output1
.Cells(iRow, 8).Value = Trim(Replace(Output1, " ", " "))
End If
Next iRow
' Output2
'different fruits
Set collFruit = New Collection
For iRow = 2 To iLastRow
On Error Resume Next
collFruit.Add .Cells(iRow, 1).Value, .Cells(iRow, 1).Value
On Error GoTo 0
Next
For Each Fruit In collFruit
Set collOutput2 = New Collection
iFruitRow = 0
For iRow = 2 To iLastRow
If .Cells(iRow, 1).Value = Fruit Then
If iFruitRow = 0 Then iFruitRow = iRow
On Error Resume Next
collOutput2.Add iRow, .Cells(iRow, 8).Value
On Error GoTo 0
End If
Next
Output2 = vbNullString
For Each Output2Line In collOutput2
Output2 = Output2 & .Cells(Output2Line, 8).Value & vbLf & vbLf
Next
.Cells(iFruitRow, 9).Value = Left(Output2, Len(Output2) - 1)
Next
End With
MsgBox "Done"
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.