VBA to create reference number based on another cell

[notruck]

Hello All ......

I need to create a "reference" or "sequence" number like seen in the number column below. This number would only be created when "Weekend Pass" is in the type column and would need to loop through all rows in the worksheet. The quantity and type columns are the only columns with existing data. Any ideas?

Number	Quantity	Type
001	1	Weekend Pass with Night Access
002	1	Weekend Pass with Night Access
	1	Night Access
003, 004	2	Weekend Pass
005	1	Weekend Pass with Night Access
006, 007	2	Weekend Pass
	1	Monthly
008	1	Weekend Pass
009	1	Weekend Pass with Night Access
	3	Monthly
010, 011, 012	3	Weekend Pass
	1	Monthly
	1	Night Access
	1	Night Access
013	1	Weekend Pass with Night Access
014	1	Weekend Pass

<tbody>
</tbody>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG23Jul56
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nstr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("C2", Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] InStr(Dn.Value, "Weekend Pass") > 0 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] n = 1 To Dn.Offset(, -1)
            c = c + 1
            nstr = nstr & IIf(nstr = "", Format(c, "000"), ", " & Format(c, "000"))
        [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]With[/COLOR] Dn.Offset(, -2)
        .NumberFormat = "000"
        .Value = nstr: nstr = ""
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[notruck]

Thanks Mick .... awesome, works great, fast response, terrific. But I forgot to mention something . Is it possible to use an OR with InStr? I forgot "Exempt" as a type.

Try this:-

[COLOR=Navy]Sub[/COLOR] MG23Jul56
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nstr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range("C2", Range("C" & Rows.Count).End(xlUp))
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] InStr(Dn.Value, "Weekend Pass") > 0 [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]For[/COLOR] n = 1 To Dn.Offset(, -1)
            c = c + 1
            nstr = nstr & IIf(nstr = "", Format(c, "000"), ", " & Format(c, "000"))
        [COLOR=Navy]Next[/COLOR] n
    [COLOR=Navy]With[/COLOR] Dn.Offset(, -2)
        .NumberFormat = "000"
        .Value = nstr: nstr = ""
    [COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG23Jul04
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nstr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("C2", Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] InStr(Dn.Value, "Weekend Pass") > 0 Or InStr(Dn.Value, "Exempt") > 0 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] n = 1 To Dn.Offset(, -1)
            c = c + 1
            nstr = nstr & IIf(nstr = "", Format(c, "000"), ", " & Format(c, "000"))
        [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]With[/COLOR] Dn.Offset(, -2)
        .NumberFormat = "000"
        .Value = nstr: nstr = ""
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[notruck]

Thank You so much .....

 

[MickG]

You're welcome