Insert Consecutive Numbers in the Middle Of Each Cell in a Selecti

  • Thread starter Thread starter CitizenKate
  • Start date Start date
C

CitizenKate

Hello,
I work with lists that look like this:

How To Build A Chair - Getting Started
How To Build A Chair - The Hard Part
How To Build A Chair - Cleaning Up
Forgotten Tales From Nova Scotia
When To Say No
Jack's Favorite Foods - Breakfast
Jack's Favorite Foods - Snacks
Jack's Favorite Foods - Drinks
Jack's Favorite Foods - Picnics

I want to build a macro that will allow me to select all the cells from the
same book, run the macro, and end up with this:

How To Build A Chair - 1. Getting Started
How To Build A Chair - 2. The Hard Part
How To Build A Chair - 3. Cleaning Up
Forgotten Tales From Nova Scotia
When To Say No
Jack's Favorite Foods - 1. Breakfast
Jack's Favorite Foods - 2. Snacks
Jack's Favorite Foods - 3. Drinks
Jack's Favorite Foods - 4. Picnics

I've recorded and written macros before, but never with any of the kinds of
variables and loops I think i'll need here. Any suggestions, advice or links
will be greatly appreciated.

Warmly,
CitizenKate
 
Try code like the following. Change the line

Set R = Range("A1") '<<< Change to start cell

to reference the cell in which your text begins. The code will scan
down until a blank cell is encountered.


Sub AAAA()

Dim R As Range
Dim N As Long
Dim Pos As Long
Dim S As String
Dim S2 As String
Dim T As String

Set R = Range("A1") '<<< Change to start cell
Do Until R.Value = vbNullString
Pos = InStr(1, R.Value, "-", vbBinaryCompare)
If Pos > 0 Then
N = N + 1
S = Left(R.Value, Pos + 1)
T = Mid(R.Value, Pos + 2)
Pos = InStr(1, R(2, 1).Value, "-", vbBinaryCompare)
If Pos > 0 Then
S2 = Left(R(2, 1).Value, Pos + 1)
If StrComp(S, S2, vbTextCompare) = 0 Then
R.Value = S & CStr(N) & " " & T
Else
If N > 0 Then
Pos = InStr(1, R(2, 1).Value, "-",
vbBinaryCompare)
If Pos > 0 Then
S = Left(R(2, 1).Value, Pos + 1)
T = Mid(R(2, 1).Value, Pos + 2)
R(2, 1).Value = S & CStr(N) & " " & T
End If
End If
N = 0
End If
Else
Pos = InStr(1, R.Value, "-", vbBinaryCompare)
If Pos > 0 Then
S = Left(R.Value, Pos + 1)
T = Mid(R.Value, Pos + 2)
R.Value = S & CStr(N) & " " & T
End If
N = 0
End If
End If
Set R = R(2, 1)
Loop

End Sub


Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
 
Select the range to be converted and try the below macro;

Sub Macro()

Dim arrData As Variant, strData As String, intCount As Integer

For Each cell In Selection
If InStr(cell, "-") Then
arrData = Split(cell, "-")
If strData <> arrData(0) Then intCount = 1
arrData(1) = intCount & "." & arrData(1)
cell.Value = Join(arrData, "-")
strData = arrData(0)
intCount = intCount + 1
End If
Next

End Sub
 
Holy Cow, Jacob! This so short and simple-looking. I'm not anywhere near the
skill level to have come up with this. I've learned a lot just looking at it.
A total eye-opener.
Thank you so much.
Kate
 
Back
Top