Macro to merge text and delete rows

[Guest]

Hi

I have a list of text statements in Col A but it needs tidying up before I
can use it.

Basically I need a macro which scrolls down Col A and counts the commas. If
the comma count is 15 it moves on to the next cell but if it's 12 it cuts the
data from 2 rows below and adds it to the end of the current row. That will
make the comma count 15 as the data had been split but is now joined up.

Where there is initially a count of 12 the next row will always have zero
commas so I need to delete rows with no commas (including the rows that had 3
until the text was added to the end of the cell 2 rows up) so I finish with a
continuous list where the comma count is 15

I can count the commas with a formula
=(LEN(A1)-LEN(SUBSTITUTE(A1,",","")))/LEN(",") but I'm not sure how to put
this into a macro that will also cut and join text and delete the unwanted
rows.

Any help would be much appreciated

Thanks a lot

Kewa

 

[Joel]

Sub combinedrows()

LastRow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = 1
Do While RowCount <= LastRow
Data = Range("A" & RowCount).Value
commarcount = 0
For i = 1 To Len(Data)
If Mid(Data, i, 1) = "," Then
commarcount = commarcount + 1
End If
Next i
If commarcount = 12 Then
Data = Data & Range("A" & (RowCount + 2)).Value
Range("A" & RowCount) = Data
Rows((RowCount + 1) & ":" & (RowCount + 2)).Delete
End If

RowCount = RowCount + 1
Loop

End Sub

 

[Guest]

That's brilliant Joel - works perfectly. Thanks a lot

Kewa