Insert alt enter into a cell or a column with defined comma counted

[Kevincwk2000]

Dear Sir,

I am looking for a code to insert alt-enter into a cell or a column with a defined comma count per line, saying 5

is

C1,C2,C3,C4,C5,C6,C7
C8,C9,C10,C11

want to change the cell(s) as

C1,C2,C3,C4,C5,
C6,C7,C8,C9,C10,
C11

thanks,
Kevin

 

[MickG]

Hi The reason for the odd result was you already had a "chr(10)" in the line .
This should sort that.

Dim oCt, oNum As Integer, nNum As String, Rep As String
Rep = Replace(Selection.Value, Chr(10), "")
oCt = Split(Rep, ",")

For oNum = 0 To UBound(oCt)
        If oNum <> 0 And (oNum + 1) Mod 5 = 0 Then
                nNum = nNum & oCt(oNum) & "," & Chr(10)
            Else
                nNum = nNum & oCt(oNum) & ","
        End If
Next oNum

With Range(Selection.Address)
.Value = nNum
.WrapText = True
End With

Regards Mick

 

[Kevincwk2000]

Hi Mick,

It seems OK for one cell.

run-time error will occur (type mismatch) if selected range of cells.

Is it able to apply the change on range of cell or a column?

thanks.
Kevin

 

[MickG]

Hi Kevin, Have a Go with this.
Select Range, Run Code

Dim oCt, oNum As Integer, nNum As String, Rep As String
Dim rng As Range, Dn As Range
Set rng = Selection
For Each Dn In rng

Rep = Replace(Dn, Chr(10), "")
oCt = Split(Rep, ",")

For oNum = 0 To UBound(oCt)
        If oNum <> 0 And (oNum + 1) Mod 5 = 0 Then
                nNum = nNum & oCt(oNum) & "," & Chr(10)
            Else
                nNum = nNum & oCt(oNum) & ","
        End If
Next oNum

With Range(Dn.Address)
.Value = nNum
.WrapText = True

End With
nNum = ""
Next Dn

Regards Mick

 

[GMorris]

EDIT: Guess I was a minute late on this one. Sorry!

You could iterate through the range with a For Each loop:
(The lines with the -> in front)

Dim oCt, oNum As Integer, nNum As String, Rep As String, oCell
Rep = Replace(Selection.Value, Chr(10), "")
oCt = Split(Rep, ",")

->For Each oCell in Range(a1:a151)

For oNum = 0 To UBound(oCt)
        If oNum <> 0 And (oNum + 1) Mod 5 = 0 Then
                nNum = nNum & oCt(oNum) & "," & Chr(10)
            Else
                nNum = nNum & oCt(oNum) & ","
        End If
Next oNum

With Range(Selection.Address)
.Value = nNum
.WrapText = True
End With
->Next

Or something like that. I haven't tested it, Excel keeps locking up on me for some reason, but that should get you in the right direction anyway.

 

[Kevincwk2000]

Hi Mick,

Oh, I found either of your codes introduced an extra comma by the end of the cells. Could you fix the problem?

In addition, please trim all the space as well.

thanks,
Kevin

 

[MickG]

Hi Kevin, This should be better !

Dim oCt, oNum As Integer, nNum As String, Rep As String
Dim rng As Range, Dn As Range
Set rng = Selection
For Each Dn In rng

Rep = Replace(Dn, Chr(10), "")
oCt = Split(Rep, ",")

For oNum = 0 To UBound(oCt)
        If oCt(oNum) <> "" And (oNum + 1) Mod 5 = 0 Then
                nNum = nNum & Trim(oCt(oNum)) & "," & Chr(10)
            Else
                nNum = nNum & Trim(oCt(oNum)) & ","
        End If
Next oNum

If nNum <> "" Then
  With Range(Dn.Address)
      .Value = Left(nNum, Len(nNum) - 1)
      .WrapText = True
      .Columns.AutoFit
  End With
nNum = ""
End If
Next Dn

Mick

 

[Kevincwk2000]

Hi Mick,

It seems still had bugs on the code.

WAS:-

<TABLE style="WIDTH: 349pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=465 border=0 x:str><COLGROUP><COL style="WIDTH: 349pt; mso-width-source: userset; mso-width-alt: 14880" width=465><TBODY><TR style="HEIGHT: 57.75pt; mso-height-source: userset" height=77><TD class=xl67 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 349pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 57.75pt; BACKGROUND-COLOR: transparent" width=465 height=77>C4,C60,C62,
C67,C94,C100,C103,C113,C117,C919,C926,
C932,C1125,C1136,C1137

IS:-
</TD></TR></TBODY></TABLE>
<TABLE style="WIDTH: 347pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=462 border=0 x:str><COLGROUP><COL style="WIDTH: 347pt; mso-width-source: userset; mso-width-alt: 14784" width=462><TBODY><TR style="HEIGHT: 57.75pt; mso-height-source: userset" height=77><TD class=xl67 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 347pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 57.75pt; BACKGROUND-COLOR: transparent" width=462 height=77>C4,C60,C62,C67,C94,
C100,C103,C113,C117,C919,
C926,C932,C1125,C1136,C1137,</TD></TR></TBODY></TABLE>An extra comma be added in the last.

thanks,
Kevin

 

[MickG]

Hi This is about as close as I'm going to get.
Error reason:- Because the entire length of the Text was divisible by 5, the last Charactor became a Chr(10) and was deleted leaving the "Comma".

Dim oCt, oNum As Integer, nNum As String, Rep As String, C As Integer
Dim rng As Range, Dn As Range
Application.ScreenUpdating = False

Set rng = Selection
For Each Dn In rng
C = 1

Rep = Replace(Dn, Chr(10), "")
oCt = Split(Rep, ",")

For oNum = 0 To UBound(oCt)
        If oCt(oNum) <> "" And (oNum + 1) Mod 5 = 0 Then
                nNum = nNum & Trim(oCt(oNum)) & "," & Chr(10)
            Else
                nNum = nNum & Trim(oCt(oNum)) & ","
        End If
Next oNum


If Right(nNum, 1) = Chr(10) Then C = 2

If nNum <> "" Then
    With Range(Dn.Address)
      .Value = Left(nNum, Len(nNum) - C)
      .WrapText = True
      .Columns.AutoFit
      .Rows.AutoFit
  End With
nNum = ""
End If
Next Dn
Application.ScreenUpdating = True

Good Luck Mick

 

[Kevincwk2000]

Hi Mick,

This code works fine.
In more convenience, could you further enhance the code to apply the changes on a column (default column g) in a workbook with multi-worksheet?

thanks,
Kevin

 

[MickG]

Hi Kevin
This is now all shts Column "G"

Dim rng As Range, Dn As Range
Dim Sht As Worksheet
Application.ScreenUpdating = False
For Each Sht In ActiveWorkbook.Worksheets

Set rng = Sheets(Sht.Name).Range(Sheets(Sht.Name).Range("G1"), Sheets(Sht.Name).Range("G" & Rows.Count).End(xlUp))

For Each Dn In rng

C = 1

Rep = Replace(Dn, Chr(10), "")
oCt = Split(Rep, ",")

For oNum = 0 To UBound(oCt)
        If oCt(oNum) <> "" And (oNum + 1) Mod 5 = 0 Then
                nNum = nNum & Trim(oCt(oNum)) & "," & Chr(10)
            Else
                nNum = nNum & Trim(oCt(oNum)) & ","
        End If
Next oNum


If Right(nNum, 1) = Chr(10) Then C = 2

If nNum <> "" Then
    With Sheets(Sht.Name).Range(Dn.Address)
      .Value = Left(nNum, Len(nNum) - C)
      .WrapText = True
      .Columns.AutoFit
      .Rows.AutoFit
  End With
nNum = ""
End If
Next Dn
Next Sht
Application.ScreenUpdating = True

Regards Mick