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

 

[brodyb1]

Also is their a way to do this where I can the formatting at the top (row 1 see image)? And how could I change the code if I want to apply the deletion to Col E instead of A? Since in col A their are some cells with "items" that don't have a part # in col E, and I wouldn't need rows if their is no part # (E:E). Just realized this and thank you again.

 

[brodyb1]

Never mind on the top row I just change it to A3 and that worked, still figuring outing changing the action to col E

 

[brodyb1]

updates: When I apply it to another sheet it doesn't work

ex: https://www.dropbox.com/s/cbxpy4xcgly635y/Excel Trial Sheet 2.xlsx?dl=0

 

[Fluff]

Try this

Sub ConsolidateDelete2()

   Dim Rng As Range
   
   With Range("A3", Range("B" & Rows.Count).Offset(, -1))
      .Replace "Item", "=Item", , , False, , False, False
      For Each Rng In .SpecialCells(xlConstants).Areas
         Rng.Offset(-1, 12).Resize(1, 1).Value = Join(Application.Transpose(Rng.Offset(-1, 12).Resize(Rng.Count + 1).Value), ", ")
      Next Rng
      .SpecialCells(xlConstants).EntireRow.Delete
      .Replace "=Item", "Item", , , False, , False, False
   End With
   With Range("E3", Range("B" & Rows.Count).End(xlUp).Offset(, 3))
      .Value = Evaluate(Replace("if(istext(@),trim(@),@)", "@", .Address))
      On Error Resume Next
      .SpecialCells(xlBlanks).EntireRow.Delete
      On Error GoTo 0
   End With
End Sub

 

[Fluff]

It doesn't work on your new sheet because the data starts in col D not col A

 

[brodyb1]

Oh I didn't even see that, bad copy paste. It worked after I moved it over except I keep getting a 'Run-time error 1004' 'No cells were found' on every other sheet I try to use it on except the original. The code still works and re-formats everything but it ends with the error.

 

[Fluff]

I changed the code in post#14 to cover that, but you must have grabbed it before hand.
Try using the new code

 

[brodyb1]

Works perfect! Thank you so much

 

[Fluff]

Glad to help & thanks for the feedback.

Would you you explain what each command is doing? I'd like to learn as well

What parts of the code do you currently understand?

 

[brodyb1]

Sub ConsolidateDelete2()
'Code to auto format the excel generated from CP to send out'
'declare rng as range'
Dim Rng As Range

'Replaces Item with =Item on col a'
'pulls range from a3 and down to offest -1'
With Range("A3", Range("B" & Rows.Count).Offset(, -1))
.Replace "Item", "=Item", , , False, , False, False

'selected what cells to include'
For Each Rng In .SpecialCells(xlConstants).Areas

'offset and resize?"
Rng.Offset(-1, 12).Resize(1, 1).Value = Join(Application.Transpose(Rng.Offset(-1, 12).Resize(Rng.Count + 1).Value), ", ")
Next Rng
'selected what cells to include'
.SpecialCells(xlConstants).EntireRow.Delete
'(what, replacement, lookat, search order, MATCHCASE non case sens , matchbyte, SEARCH FORMAT method, REPLACE FORMAT replace method)'
.Replace "=Item", "Item", , , False, , False, False
End With

'delete off of column e since some col a have 'item' without desc, using for a 2nd backup'

'pulls from range e3 the start of the description and down to the end of the col a blank'
With Range("E3", Range("B" & Rows.Count).End(xlUp).Offset(, 3))
' True or False?' ' check text for value, returns true if value is text, returns false if value is not text'
.Value = Evaluate(Replace("if(istext(@),trim(@),@)", "@", .Address))
On Error Resume Next

'delete entire blank row'
.SpecialCells(xlBlanks).EntireRow.Delete
'Ends 1004 Error'
On Error GoTo 0

End With



End Sub