PDA

View Full Version : Solved: insert space in a string after n characters



hunna
12-02-2011, 02:04 AM
Hi there,

I need help for a code that insert space in a string after 10 characters.


for example >> MQGSVTEFLKPRLVDIEQVSSTHAKVTLEPLERGFGHTLG...

out put >> MQGSVTEFLK PRLVDIEQVS STHAKVTLEP LERGFGHTLG ...




Thanks,

Aflatoon
12-02-2011, 02:19 AM
Perhaps something like this:
Sub testing()
Debug.Print InsertSpaceEveryN("MQGSVTEFLKPRLVDIEQVSSTHAKVTLEPLERGFGHTLG", 10)
End Sub
Function InsertSpaceEveryN(strInput As String, n As Long) As String
Dim strTemp As String
Dim lngIndex As Long

For lngIndex = 1 To Len(strInput) Step n
strTemp = strTemp & " " & Mid$(strInput, lngIndex, n)
Next lngIndex
InsertSpaceEveryN = Mid$(strTemp, 2)
End Function

hunna
12-02-2011, 02:56 AM
Hi Aflatoon (http://www.vbaexpress.com/forum/member.php?u=24778),

thank you very much for your help. I have one more question that if a string I want to add a space is in range A1, so can I do this?


Sub testing()
Debug.Print InsertSpaceEveryN(A1, 10)
End Sub


Function InsertSpaceEveryN(strInput As String, n As Long) As String
Dim strTemp As String
Dim lngIndex As Long

For lngIndex = 1 To Len(strInput) Step n
strTemp = strTemp & " " & Mid$(strInput, lngIndex, n)
Next lngIndex
InsertSpaceEveryN = Mid$(strTemp, 2)
End Function

Aflatoon
12-02-2011, 03:07 AM
It would be:
Sub testing()
Debug.Print InsertSpaceEveryN(Range("A1").Value, 10)
End Sub

hunna
12-02-2011, 03:27 AM
Thank you again!!! ;)

hunna
12-02-2011, 05:05 AM
I am sorry that I need to bother you again,

If the data is in A1 and I want to add the spaces (with your code) to A1, if it's possible?

Thanks,

Aflatoon
12-02-2011, 05:09 AM
Sub testing()
Range("A1").Value = InsertSpaceEveryN(Range("A1").Value, 10)
End Sub

hunna
12-02-2011, 05:23 AM
I think I must do something wrong.

I place the code to new module and create a button to start the code but nothing happens.

If I add =InsertSpaceEveryN(A1, 10) to certain range then it works.

could you please tell me what could be the problem?

thanks,

Aflatoon
12-02-2011, 05:25 AM
Did you assign the testing macro to the button?

hunna
12-02-2011, 05:30 AM
yes I did.

Aflatoon
12-02-2011, 05:39 AM
Then I do not see how it would not work assuming the correct sheet is active.

hunna
12-02-2011, 05:52 AM
what I do exactly; add the code to module then create a button on sheet1 after that assign to testing macro. I input data to range A1. The code that I add is

Sub testing()
Debug.Print InsertSpaceEveryN(Range("A1").Value, 10)
End Sub

Function InsertSpaceEveryN(strInput As String, n As Long) As String
Dim strTemp As String
Dim lngIndex As Long

For lngIndex = 1 To Len(strInput) Step n
strTemp = strTemp & " " & Mid$(strInput, lngIndex, n)
Next lngIndex
InsertSpaceEveryN = Mid$(strTemp, 2)
End Function
Nothing is happenning after I click the button.

Anyway thank you for your kind and rapid reply. I will try to find what I did wrongly. If I get it I let you know.

Thanks,

Aflatoon
12-02-2011, 08:22 AM
You could always post the workbook here if you get stuck.

frank_m
12-02-2011, 09:03 AM
HI hunna (http://www.vbaexpress.com/forum/member.php?u=42415),

Keep the function as you have it, except put it in a regular module, along with the testing sub. And change the testing sub command to what Aflatoon provided in post#7 - Then you can call the sub using Call testing from within an activex button, or asign a sheet forms type button to the macro.

hunna
12-02-2011, 10:53 AM
Hi Aflatoon (http://www.vbaexpress.com/forum/member.php?u=24778) and frank_m (http://www.vbaexpress.com/forum/member.php?u=36425),

thanks for your help. I have attached a worksheet, please have a look?

Thanks,

Aflatoon
12-02-2011, 01:07 PM
You have the wrong version of the testing sub - it is still the debug.print version, not the one I posted subsequently.

hunna
12-02-2011, 02:27 PM
Hi Aflatoon (http://www.vbaexpress.com/forum/member.php?u=24778),

Thank you very much, now it works like a charm. I am sorry that I need to ask another question. After adding a space to data, the font color is changed back to default (of that range). If it's possible not to change the original format.

for example >> MQGSVTEFLKPRLVDIEQVSSTHAKVTLEPLERGFGHTLG...

output >> MQGSVTEFLK PRLVDIEQVS STHAKVTLEP LERGFGHTLG ...

disired output >> MQGSVTEFLK PRLVDIEQVS STHAKVTLEP LERGFGHTLG ...

Aflatoon
12-02-2011, 02:39 PM
That can be done but it will take a bit of work. I cannot look at that until next week at the earliest, I am afraid.

hunna
12-02-2011, 11:12 PM
thank you very much for your help. It's fine not to change it.

GTO
12-03-2011, 09:23 AM
Probably a little klutzy, but seems to work:


Option Explicit

Sub test()
Dim Cell As Range
Dim a_vntCharProps() As Variant
Dim a_vntStringColors As Variant
Dim strOut As String
Dim i As Long
Dim n As Long
Dim lColorIndex As Long
Dim bolIsWorksheet As Boolean

On Error Resume Next
bolIsWorksheet = ActiveSheet.Type = xlWorksheet
On Error GoTo 0

If bolIsWorksheet Then
For Each Cell In Selection
lColorIndex = 9999
ReDim a_vntStringColors(1 To 2, 0 To 0)
If GetChars(Cell, 10, a_vntCharProps) Then
strOut = vbNullString
For i = LBound(a_vntCharProps, 1) To UBound(a_vntCharProps, 1)
strOut = strOut & a_vntCharProps(i, 1)
If a_vntCharProps(i, 2) = lColorIndex Then

a_vntStringColors(2, UBound(a_vntStringColors, 2)) _
= a_vntStringColors(2, UBound(a_vntStringColors, 2)) + 1
Else
ReDim Preserve a_vntStringColors(1 To 2, _
1 To UBound(a_vntStringColors, 2) + 1)
lColorIndex = a_vntCharProps(i, 2)
a_vntStringColors(1, UBound(a_vntStringColors, 2)) = lColorIndex
a_vntStringColors(2, UBound(a_vntStringColors, 2)) = 1
End If
Next

Cell.Value = strOut
n = 1
For i = LBound(a_vntStringColors, 2) To UBound(a_vntStringColors, 2)
Cell.Characters(n, a_vntStringColors(2, i)).Font.ColorIndex _
= a_vntStringColors(1, i)
n = n + a_vntStringColors(2, i)
Next
End If
Next
End If
End Sub

Function GetChars(Rng As Range, n As Long, ary() As Variant) As Boolean
Dim lLen As Long
Dim lCharPos As Long
Dim i As Long
Dim strTmp As String

If Len(Rng.Value) < 11 Or IsNumeric(Rng.Value) Then Exit Function
strTmp = Rng.Value
lLen = (Len(strTmp) \ n) + Abs(CBool(Len(strTmp) Mod n)) - 1 + Len(strTmp)
ReDim ary(1 To lLen, 1 To 2) As Variant

For i = LBound(ary, 1) To UBound(ary, 1)
If Not CBool(i Mod (n + 1)) Then
ary(i, 1) = Chr(32)
ary(i, 2) = -4105
Else
lCharPos = lCharPos + 1
ary(i, 1) = Mid(strTmp, lCharPos, 1)
ary(i, 2) = Rng.Characters(lCharPos, 1).Font.ColorIndex
End If
Next
GetChars = True
End Function

mikerickson
12-03-2011, 03:51 PM
Perhaps

Sub test()
Call InsertTextEveryN(Range("A1"), 4, " ")
End Sub

Sub InsertTextEveryN(aRange As Range, everyN As Long, insertedText As String)
Dim LOfText As Long
Dim i As Long
LOfText = Len(CStr((aRange.Cells(1, 1).Value)))
For i = Application.Floor(LOfText, everyN) + 1 To 2 Step -everyN
aRange.Cells(1,1).Characters(i, 0).Insert (insertedText)
Next i
End Sub

hunna
12-04-2011, 01:45 PM
sorry, mistake

hunna
12-05-2011, 08:29 AM
GTO (http://www.vbaexpress.com/forum/member.php?u=17945)

Thanks for the code. it works a charm.

GTO
12-05-2011, 04:42 PM
You are most welcome and glad it worked:content: