Macros : How to add multiple cells into one depending on another cell & delete empty cells after

[brodyb1]

Hello,

I'm trying to figure out in Macros how to add the multiple cells under description (M:M) into one cell, so its one continuous descriptions . The one cell with the full description needs to be on the same row with "item" under (A:A). So basically row 3 would have the the information on row 3, whereas now under the "Description" column, the description is broken up into two cells. Then after all the information has been consolidated into one row I want to delete the empty rows between each "Item" (A:A). In the end each row with "item" has all the information, and there are no empty spaces between the rows.

Sorry if I'm running in circles I've been trying to describe my problem/goal accurately. I'm also new to Macros but I've done some successful codes in the past few month but this seems far out of my reach and I was hoping someone here could help me.

I ideally want it to look like this (below). Which is did with filters and filtered out the blanks, but with filters it cuts my descriptions short, which is the problem.

https://imgur.com/acpRlfY

 

[Fluff]

1        With Range("A3", Range("B" & Rows.Count).Offset(, -1))
2           .Replace "Item", "=Item", , , False, , False, False
3           For Each Rng In .SpecialCells(xlConstants).Areas
4              Rng.Offset(-1, 12).Resize(1, 1).Value = Join(Application.Transpose(Rng.Offset(-1, 12).Resize(Rng.Count + 1).Value), ", ")
5           Next Rng
6           .SpecialCells(xlConstants).EntireRow.Delete
7           .Replace "=Item", "Item", , , False, , False, False
8        End With
9        With Range("E3", Range("B" & Rows.Count).End(xlUp).Offset(, 3))
10          .Value = Evaluate(Replace("if(istext(@),trim(@),@)", "@", .Address))
11          On Error Resume Next
12          .SpecialCells(xlBlanks).EntireRow.Delete
13          On Error GoTo 0
14       End With

1) You're correct
2) Correct, the reason is that excel will now see these cells as formulas, rather than constants
3) .SpecialCells(xlConstants).Areas returns all cells that are constants & Rng will be each contiguous group of cells. So with your data rng will initially be A4, on the 2nd loop it will be A6:A9 etc
4) On the 1st loop Rng is A4 so Rng.Offset(-1, 12).Resize(1, 1) is M3 & then Rng.Offset(-1, 12).Resize(Rng.Count + 1) becomes M3:M4
. 2nd loop Rng is A6:A9 which becomes M5 & the second part becomes M5:M9
. Application.Transpose changes the values in the 2nd range from vertical to horizontal
. Join then concatenates those values with a ", " (without the quotes)
5) Goes back to the start of the loop
6) Deletes the entire row, where col A contains a constant.
7) Changes =Item back to Item
9) "selects" col E from row 3 to the last row with data in col B
10) Replace replaces the @ symbol with .Address (effectively making the formula =IF(ISTEXT(E3),TRIM(E3),E3)) This simply removes the blanks from the cell
12) Deletes all rows where col E is blank

HTH