Excel vba to renumber

[BORUCH]

hi i have the following sheet

GDGSGDGDS.xlsx
	A	B	C
1	ITEM #	MISC	DESCRIPTION
2
3			09 FRUITS
4
5	00001		APPLES
6	00002		BANANAS
7	00003		PEARS
8	00004		WATERMELON
9
10			1 VEGETABLE
11
12	12345		TOMATOES
13	22222		CUCUMBERS
14
15			65 SNACKS & CANDY
16
17	1234		SNACKS
18	J0001		CANDY
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

 

[bebo021999]

Could you post the desired results ?

 

[Peter_SSs]

My code guess

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
	A	B	C
1	ITEM #	MISC	DESCRIPTION
2
3			1 FRUITS
4
5	1		APPLES
6	2		BANANAS
7	3		PEARS
8	4		WATERMELON
9
10			2 VEGETABLE
11
12	12345		TOMATOES
13	22222		CUCUMBERS
14
15			3 SNACKS & CANDY
16
17	1234		SNACKS
18	J0001		CANDY
Sheet1

 

[BORUCH]

My code guess

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
	A	B	C
1	ITEM #	MISC	DESCRIPTION
2
3			1 FRUITS
4
5	1		APPLES
6	2		BANANAS
7	3		PEARS
8	4		WATERMELON
9
10			2 VEGETABLE
11
12	12345		TOMATOES
13	22222		CUCUMBERS
14
15			3 SNACKS & CANDY
16
17	1234		SNACKS
18	J0001		CANDY
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]

#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]

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
	A	B	C	D
2	ITEM #	MISC	DESCRIPTION	RESULTS FOR COLUMN C
3
4			99 FRUITS	1 FRUITS
5
6	1		APPLES
7	2		BANANAS
8	3		PEARS
9	4		WATERMELON
10
11			2 VEGETABLE	2 VEGETABLE
12
13	12345		TOMATOES
14	22222		CUCUMBERS
15
16			5 SNACKS & CANDY	3 SNACKS & CANDY
17
18	1234		SNACKS
19	J0001		CANDY
20
21			MISC	4 MISC
22
23	10000		HAMMER
24	2000		NAILS
Sheet1

 

[Peter_SSs]

see attached

Thanks. Try this one.

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]

Thanks. Try this one.

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]

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

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]

Yes, I did ask about that before but didn't get a definitive answer to that question ...

.. until now.

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