asked on

Need Excel VBA Macro to Assign Two Digit Numbers to List

I have text cells that I need to assign numbers. The most I can imagine would be twenty in one list.

Before
Workbook Analysis
Workbook Relationship
Worksheet Relationship
Cell Relationship
Compare Files
Clean Excess Cell Formatting
Workbook Passwords
Help

After
01. Workbook Analysis
02. Workbook Relationship
03. Worksheet Relationship
04. Cell Relationship
05. Compare Files
06. Clean Excess Cell Formatting
07. Workbook Passwords
08. Help

Martin Liss

This assumes that the data is in column "A" and it starts in row 1.

Sub MakeList()

Dim lngLastRow As Long
Dim lngRow As Long

lngLastRow = Range("A1048576").End(xlUp).Row
For lngRow = 1 To lngLastRow
    Cells(lngRow, "A").Value = Format(lngRow, "00") & ". " & Cells(lngRow, "A").Value
Next

End Sub

Open in new window

Rgonzo1971

Hi,

pls try

Sub macro()
idx = 1
For Each c In Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    c.Value = Format(idx, "00") & ". " & c.Value
    idx = idx + 1
Next
End Sub

Open in new window

Regards

Alex Campbell

ASKER

The column could vary.

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Martin Liss

Do you want to be asked for the column or does the column have a header that is aways the same name?

Norie

Assuming list in column A and starting in row 1.

Sub NumberEntries()
Dim LastRow As Long

    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    With Range("A1:A" & LastRow)
       .Value = Evaluate("INDEX(TEXT(ROW(" & .Address & "), ""00."") & " & .Address & ",,1)")
    End With
       
End Sub

Open in new window

Martin Liss

Here's a version that finds a column named "blah".

Sub MakeList()

Dim lngLastRow As Long
Dim lngRow As Long
Dim rngFound As Range

Set rngFound = Cells.Find(What:="blah", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
If Not rngFound Is Nothing Then
    lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row

    For lngRow = 2 To lngLastRow
        Cells(lngRow, rngFound.Column).Value = Format(lngRow - 1, "00") & ". " & Cells(lngRow, rngFound.Column).Value
    Next
Else
    MsgBox "Data not found"
End If

End Sub

Open in new window

Martin Liss

And this one asks for the column.

Sub MakeList()

Dim lngLastRow As Long
Dim lngRow As Long
Dim strColumn As String

strColumn = InputBox("Which column letter")
    
lngLastRow = Range(strColumn & "1048576").End(xlUp).Row

For lngRow = 2 To lngLastRow
    Cells(lngRow, strColumn).Value = Format(lngRow - 1, "00") & ". " & Cells(lngRow, strColumn).Value
Next

End Sub

Open in new window

Mike in IT

This will add the number in front of whatever is in each cell in the column. You only have to select the first row and then run the sub.

Sub AddNumber()
Dim counted, n, j

counted = 1
j = ActiveCell.Address
n = Range(Mid(j, 2, 1) & Rows.count).End(xlUp).Row

For x = Mid(j, InStr(2, j, "$") + 1, Len(j) - InStr(2, j, "$")) To n Step 1
    If counted < 10 Then
        Range(Mid(j, 2, 1) & x).Value = "0" & counted & ". " & Range(Mid(j, 2, 1) & x).Value
    Else
        Range(Mid(j, 2, 1) & x).Value = counted & ". " & Range(Mid(j, 2, 1) & x).Value
    End If
    counted = counted + 1
Next x
End Sub

Open in new window

Alex Campbell

ASKER

Great. Does the job and simple enough that I can learn from it. Thanks!