Help Creating Promo Codes :)

[TripletDad]

I have about 15,000 promo codes to create and I want to do it using a Concatenate function...

I have a list of stores ("Stores" Tab, Column A) that I want to incorporate into the promo code -- so my formula would look like this:

=CONCATENATE('Stores'!A5,"-",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))

Now for the challenge:

I need 50 codes for each store and I have a list of ~300 stores in column A

I need a formula (or need to modify the above formula) I can drag down 15,000 rows then copy/paste special the results...

Any ideas?

 

[TripletDad]

I think it worked! Success!!!

Thank you!!!

 

[Peter_SSs]

I still don't see why the bother of
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row

Since the code is taking the 300 existing rows and copying them to row 15,000, how can lr be anything but 15,000?

I also mentioned about applying the formulas all at once. Doing so for me cuts the macro time from about 9 seconds to about 0.25 seconds.
That is, replacing the code between the two ScreenUpdating lines with this

With Range("A1").Resize(lr)
  .Formula = "=CONCATENATE(Stores!A1,""-"",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))"
  .Value = .Value
End With

3) Although the store number is only listed one time on 'Stores', I need 50 unique codes for each store, so this would have to be repeated 50 times before creating a new set of codes for the store number located in cell A2.

I'd rather not limit this to 15K rows, when we add stores in the future, I'd like to be able to leverage this same macro.

Keeping both of the above in mind, here's an alternative (similar in concept to Michael's original code but much faster) that will handle any number of stores and any number of codes per store (easily changed near the start of the code) which is a bit faster again.
It also leaves the original 'Stores' sheet unchanged.

Sub StoreCodes()
  Dim a, b
  Dim i As Long, j As Long, k As Long, Stores As Long

  Const CodesPerStore As Long = 50  '<- Change to suit
  
  With Sheets("Stores")
    a = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Value
  End With
  Stores = UBound(a, 1)
  ReDim b(1 To Stores * CodesPerStore, 1 To 1)
  For i = 1 To Stores
    For j = 1 To CodesPerStore
      k = k + 1
      b(k, 1) = a(i, 1) & -(100 + Int(Rnd() * 900)) & Chr(65 + Int(Rnd() * 26)) & _
        Chr(65 + Int(Rnd() * 26)) & (1000 + Int(Rnd() * 9000))
    Next j
  Next i
  Application.ScreenUpdating = False
  Sheets.Add(After:=Sheets("Stores")).Name = "Store Codes"
  Sheets("Store Codes").Range("A1").Resize(UBound(b, 1)).Value = b
  Application.ScreenUpdating = True
End Sub

Edit:
This still does not guarantee unique codes, but the likelihood of repeats is fairly small.

 

[Michael M]

Since the code is taking the 300 existing rows and copying them to row 15,000, how can lr be anything but 15,000?

Hi Peter
I think the OP is suggesting that there may be more than 300 stores on occasion.
I also agree with your code, but I was in the car and didn't have Excel, so took the easy option, for me anyway...

 

[TripletDad]

Hi Peter
I think the OP is suggesting that there may be more than 300 stores on occasion.
I also agree with your code, but I was in the car and didn't have Excel, so took the easy option, for me anyway...

Michael - yes - you're right... there may be more than 300 stores....

Thank you to you both for your help!

-Jeff

 

[Peter_SSs]

I think the OP is suggesting that there may be more than 300 stores on occasion.

Exactly (& has been confirmed by by the OP), which is why I provided my recent code to counter the fixed
ws.Range("A1:A300").AutoFill Destination:=ws.Range("A1:A15000"), Type:=xlFillCopy

.. so took the easy option, for me anyway...

I don't know if you are picking up on my point.
Given that you were only providing a solution for 300 stores and 50 codes per store, the "easy way out" to me would have been the blue line below, instead of the red.

ws.Range("A1:A300").AutoFill Destination:=ws.Range("A1:A15000"), Type:=xlFillCopy
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
lr = 15000