Help needed on macro for project!

[Shaun_Lin]

Hi,

I am trying to write a macro to assign a set new of serial number to each row. For example, each row will be given a number (in sequence) after every 8 rows and when there are no other numbers below it, the code will go back up again to continue the pattern again. Any help on this will be very much appreciated. Thank you!

​

[TABLE="width: 287"]
<colgroup><col style="margin-left: 40px;"><col style="margin-left: 40px;"></colgroup><tbody>[TR]
[TD]

OLD
NUMBER​

[/TD]
[TD]

NEW
SERIAL NUMBER​

[/TD]
[/TR]
[TR]
[TD]

1​

[/TD]
[TD]

1​

[/TD]
[/TR]
[TR]
[TD]

2​

[/TD]
[TD]

4​

[/TD]
[/TR]
[TR]
[TD]

3​

[/TD]
[TD]

7​

[/TD]
[/TR]
[TR]
[TD]

4​

[/TD]
[TD]

10​

[/TD]
[/TR]
[TR]
[TD]

5​

[/TD]
[TD]

13​

[/TD]
[/TR]
[TR]
[TD]

6​

[/TD]
[TD]

16​

[/TD]
[/TR]
[TR]
[TD]

7​

[/TD]
[TD]

19​

[/TD]
[/TR]
[TR]
[TD]

8​

[/TD]
[TD]

22​

[/TD]
[/TR]
[TR]
[TD]

9​

[/TD]
[TD]

2​

[/TD]
[/TR]
[TR]
[TD]

10​

[/TD]
[TD]

5​

[/TD]
[/TR]
[TR]
[TD]

11​

[/TD]
[TD]

8​

[/TD]
[/TR]
[TR]
[TD]

12​

[/TD]
[TD]

11​

[/TD]
[/TR]
[TR]
[TD]

13​

[/TD]
[TD]

14​

[/TD]
[/TR]
[TR]
[TD]

14​

[/TD]
[TD]

17​

[/TD]
[/TR]
[TR]
[TD]

15​

[/TD]
[TD]

20​

[/TD]
[/TR]
[TR]
[TD]

16​

[/TD]
[TD]

23​

[/TD]
[/TR]
[TR]
[TD]

17​

[/TD]
[TD]

3​

[/TD]
[/TR]
[TR]
[TD]

18​

[/TD]
[TD]

6​

[/TD]
[/TR]
[TR]
[TD]

19​

[/TD]
[TD]

9​

[/TD]
[/TR]
[TR]
[TD]

20​

[/TD]
[TD]

12​

[/TD]
[/TR]
[TR]
[TD]

21​

[/TD]
[TD]

15​

[/TD]
[/TR]
[TR]
[TD]

22​

[/TD]
[TD]

18​

[/TD]
[/TR]
[TR]
[TD]

23​

[/TD]
[TD]

21​

[/TD]
[/TR]
[TR]
[TD]

24​

[/TD]
[TD]

24​

[/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG22Jun29
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] c, st [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("a" & Rows.Count).End(xlUp))
num = Rng.Count / 8
c = 1: st = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   Dn.Offset(, 1) = c: n = n + 1
   [COLOR="Navy"]If[/COLOR] n Mod 8 = 0 [COLOR="Navy"]Then[/COLOR]
      st = st + 1: c = st
   [COLOR="Navy"]Else[/COLOR]
       c = c + num
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[bhos123]

Sub macro4()

Dim lastrow1 As Long
Dim k As Long
Dim l As Long
Dim j As Long

k = 2
l = 1

With ActiveSheet
lastrow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

For i = 1 To lastrow1 - 1

j = k + (l - 1) * 8
If j > lastrow1 Then
k = k + 1
l = 1
j = k + (l - 1) * 8
End If

Cells(j, 2).Value = i
l = l + 1
Next
Cells(1, 2).Value = "New Series"
End Sub

 

[Shaun_Lin]

Dear MickG and bhos123,

Thanks for the prompt reply and help! The solutions work fine and I was able to solve the problem with that.

 

[MickG]

You're welcome

 

[bhos123]

Welcome