Excel vba to renumber

BORUCH

Active Member
Joined
Mar 1, 2016
Messages
460
Office Version
  1. 365
Platform
  1. Windows
hi i have the following sheet

GDGSGDGDS.xlsx
ABC
1ITEM # MISCDESCRIPTION
2
309 FRUITS
4
500001APPLES
600002BANANAS
700003PEARS
800004WATERMELON
9
101 VEGETABLE
11
1212345TOMATOES
1322222CUCUMBERS
14
1565 SNACKS & CANDY
16
171234SNACKS
18J0001CANDY
Sheet1


i would like for the vba to remove the numbers that are already there from my categories and renumber them as 1,2,3,

Thanks
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,596
Office Version
  1. 365
Platform
  1. Windows
My code guess

VBA Code:
Sub ReNumber()
  Dim rA As Range
  Dim i As Long
  
  For Each rA In Columns("C").SpecialCells(xlTextValues).Areas
    If rA.Count = 1 And IsNumeric(Left(rA.Cells(1).Value, 1)) Then
      i = i + 1
      rA.Value = i & Mid(rA.Value, InStr(1, rA.Value, " "))
    End If
  Next rA
End Sub

My results

BORUCH.xlsm
ABC
1ITEM # MISCDESCRIPTION
2
31 FRUITS
4
51APPLES
62BANANAS
73PEARS
84WATERMELON
9
102 VEGETABLE
11
1212345TOMATOES
1322222CUCUMBERS
14
153 SNACKS & CANDY
16
171234SNACKS
18J0001CANDY
Sheet1
 

BORUCH

Active Member
Joined
Mar 1, 2016
Messages
460
Office Version
  1. 365
Platform
  1. Windows
My code guess

VBA Code:
Sub ReNumber()
  Dim rA As Range
  Dim i As Long
 
  For Each rA In Columns("C").SpecialCells(xlTextValues).Areas
    If rA.Count = 1 And IsNumeric(Left(rA.Cells(1).Value, 1)) Then
      i = i + 1
      rA.Value = i & Mid(rA.Value, InStr(1, rA.Value, " "))
    End If
  Next rA
End Sub

My results

BORUCH.xlsm
ABC
1ITEM # MISCDESCRIPTION
2
31 FRUITS
4
51APPLES
62BANANAS
73PEARS
84WATERMELON
9
102 VEGETABLE
11
1212345TOMATOES
1322222CUCUMBERS
14
153 SNACKS & CANDY
16
171234SNACKS
18J0001CANDY
Sheet1
thanks for the code

just two fixes if possible

#1 my data starts at C2

#2 sometimes i can have a category without numbers i still want it to add the number before the text

thank you
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,596
Office Version
  1. 365
Platform
  1. Windows
#2 sometimes i can have a category without numbers i still want it to add the number before the text
In that case, how do we determine what is a category heading and what is not? For example, I'm thinking that it may be possible to have a category with just one item below?

Could we have some fresh sample data that reflects existing samples and your two newly raised points? When giving the sample data, please manually insert the desired results in column D and post columns C:D with XL2BB
 

BORUCH

Active Member
Joined
Mar 1, 2016
Messages
460
Office Version
  1. 365
Platform
  1. Windows
In that case, how do we determine what is a category heading and what is not? For example, I'm thinking that it may be possible to have a category with just one item below?

Could we have some fresh sample data that reflects existing samples and your two newly raised points? When giving the sample data, please manually insert the desired results in column D and post columns C:D with XL2BB
Hi sorry for the delay see attached

Book1
ABCD
2ITEM # MISCDESCRIPTION RESULTS FOR COLUMN C
3
499 FRUITS1 FRUITS
5
61APPLES
72BANANAS
83PEARS
94WATERMELON
10
112 VEGETABLE2 VEGETABLE
12
1312345TOMATOES
1422222CUCUMBERS
15
165 SNACKS & CANDY3 SNACKS & CANDY
17
181234SNACKS
19J0001CANDY
20
21MISC4 MISC
22
2310000HAMMER
242000NAILS
Sheet1
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,596
Office Version
  1. 365
Platform
  1. Windows
see attached
Thanks. Try this one.

VBA Code:
Sub ReNumber_v2()
  Dim rA As Range
  Dim i As Long
  
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlTextValues).Areas
    If rA.Count = 1 Then
      i = i + 1
      rA.Value = i & " " & Mid(rA.Value, IIf(IsNumeric(Left(rA.Cells(1).Value, 1)), InStr(1, rA.Value, " ") + 1, 1))
    End If
  Next rA
End Sub
 

BORUCH

Active Member
Joined
Mar 1, 2016
Messages
460
Office Version
  1. 365
Platform
  1. Windows
Thanks. Try this one.

VBA Code:
Sub ReNumber_v2()
  Dim rA As Range
  Dim i As Long
 
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlTextValues).Areas
    If rA.Count = 1 Then
      i = i + 1
      rA.Value = i & " " & Mid(rA.Value, IIf(IsNumeric(Left(rA.Cells(1).Value, 1)), InStr(1, rA.Value, " ") + 1, 1))
    End If
  Next rA
End Sub
Thanks code works perfectly !
we would just need to accommodate a scenario where a category only has one single item in it.
I guess we can put some if statement that it only runs the code if the cell in column A is blank
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,596
Office Version
  1. 365
Platform
  1. Windows
we would just need to accommodate a scenario where a category only has one single item in it.
Yes, I did ask about that before but didn't get a definitive answer to that question ...
In that case, how do we determine what is a category heading and what is not? For example, I'm thinking that it may be possible to have a category with just one item below?
.. until now. ;)
.... only runs the code if the cell in column A is blank

Rich (BB code):
Sub ReNumber_v3()
  Dim rA As Range
  Dim i As Long
 
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlTextValues).Areas
    If rA.Count = 1 And IsEmpty(Cells(rA.Row, 1).Value) Then
      i = i + 1
      rA.Value = i & " " & Mid(rA.Value, IIf(IsNumeric(Left(rA.Cells(1).Value, 1)), InStr(1, rA.Value, " ") + 1, 1))
    End If
  Next rA
End Sub
 

BORUCH

Active Member
Joined
Mar 1, 2016
Messages
460
Office Version
  1. 365
Platform
  1. Windows
Yes, I did ask about that before but didn't get a definitive answer to that question ...

.. until now. ;)


Rich (BB code):
Sub ReNumber_v3()
  Dim rA As Range
  Dim i As Long
 
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlTextValues).Areas
    If rA.Count = 1 And IsEmpty(Cells(rA.Row, 1).Value) Then
      i = i + 1
      rA.Value = i & " " & Mid(rA.Value, IIf(IsNumeric(Left(rA.Cells(1).Value, 1)), InStr(1, rA.Value, " ") + 1, 1))
    End If
  Next rA
End Sub
Thanks works perfectly
 

Forum statistics

Threads
1,176,420
Messages
5,903,025
Members
435,002
Latest member
chenmoti

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top