Help Creating Promo Codes :)

TripletDad

Board Regular
Joined
Oct 19, 2010
Messages
121
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?
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,396
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Maybe something like this.
A couple of assumptions though
ALL the stores are listed in Col "A" of Sheet "Stores"
The promo codes are listed in consecutive columns for each store

Copy this code and then run it while you have a blank sheet active

Code:
Sub MM1()
Dim c As Integer, lr As Long, r As Long
lr = Sheets("Stores").Cells(Rows.Count, "A").End(xlUp).Row
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
    For c = 1 To 50
        For r = 1 To lr
            Cells(r, c).Formula = "=CONCATENATE(Stores!A" & r & ","" - "",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))"
            With Cells(r, c)
                .Value = .Value
            End With
        Next r
    Next c
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
 

TripletDad

Board Regular
Joined
Oct 19, 2010
Messages
121
Maybe something like this.
A couple of assumptions though
ALL the stores are listed in Col "A" of Sheet "Stores"
The promo codes are listed in consecutive columns for each store

Copy this code and then run it while you have a blank sheet active

Code:
Sub MM1()
Dim c As Integer, lr As Long, r As Long
lr = Sheets("Stores").Cells(Rows.Count, "A").End(xlUp).Row
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
    For c = 1 To 50
        For r = 1 To lr
            Cells(r, c).Formula = "=CONCATENATE(Stores!A" & r & ","" - "",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))"
            With Cells(r, c)
                .Value = .Value
            End With
        Next r
    Next c
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

Michael -

Thank you for putting this together... would you mind changing this so all the codes (for all stores) show in Column A (not consecutive columns in the new sheet)?

Thanks!

-Jeff
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,396
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Try
Code:
Sub MM1()
Dim c As Integer, lr As Long, r As Long
Sheets("Stores").Range("A1:A300").AutoFill Destination:=Sheets("Stores").Range("A1:A15000"), Type:=xlFillCopy
lr = Sheets("Stores").Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
        For r = 1 To lr
            Cells(r, 1).Formula = "=CONCATENATE(Stores!A" & r & ","" - "",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))"
            With Cells(r, 1)
                .Value = .Value
            End With
        Next r
Application.ScreenUpdating = True
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,213
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Michael/Jeff. A few comments/suggestions regarding the suggested code (in post #4) for you to consider.

1. Maybe very unlikely, but what would stop multiple (or theoretically even all) the codes for a given store being identical?
Is it critical that all codes are unique?

2. The 'Stores' sheet data is modified by the code. That sheet may need returning to its original state.

3. The filling of rows is hard-code to 15,000 so why get the code to work out that lr = 15000?

4. If this method is persisted with, there is no need to apply the formula and value to each of the 15,000 rows separately. This would do the lot for that section of code
Code:
With Range("A1:A15000")
  .Formula = "=CONCATENATE(Stores!A1 & "" - "",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))"
  .Value = .Value
End With
 

TripletDad

Board Regular
Joined
Oct 19, 2010
Messages
121
Peter - thank you for those suggestions... I think they're very valid points.

* It is not Critical that all codes are unique, but it would be very helpful.
* I'm not worried about the Stores sheet being modified, but I was thinking the codes would be inserted into a new sheet.
* 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.

Would you mind helping and providing the entire macro? I'm not sure where to insert the modified code you provided.

Thanks!

-Jeff
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,396
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

Jeff
My original code allowed for any number of rows, but this will also put it onto a new sheet called "Stores Modified"
Code:
Sub MM1()
Dim c As Integer, lr As Long, r As Long, ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("Stores")
ws.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Stores Modified"
Set ws2 = Sheets("Stores Modified")
ws2.Range("A1:A300").AutoFill Destination:=ws2.Range("A1:A15000"), Type:=xlFillCopy
lr = ws2.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
        For r = 1 To lr
            With Cells(r, 1)
                .Formula = "=CONCATENATE(Stores!A" & r & ","" - "",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))"
                .Value = .Value
            End With
        Next r
Application.ScreenUpdating = True
End Sub
 

TripletDad

Board Regular
Joined
Oct 19, 2010
Messages
121
Michael - I'm sorry, but I still can't get this to work...

When I run the macro, it adds the tab you expected (Stores Modified), but the codes aren't correct. It concatenates the store and codes (ex: 999 - 853XI4940), but it only works for the ~300 stores I have listed. After that, it shows the following: - 425TZ8034.

I need it to do the following:

1) Look at 'Stores' Cell A1 - this holds the store number
2) Concatenate the following: Store Number, Hyphen, 3 Random Numbers, 2 Random Letters, 4 random numbers. Example: 999-482LX5916 where 999 is the store number. (Note: No spaces)
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.

Does this make sense?

Please guys... I really need your help.

Thanks,

-Jeff
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,396
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Jeff
I don't have Excel at the moment, but try this....UNTESTED
Code:
Sub MM1()
Dim c As Integer, lr As Long, r As Long, ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("Stores")
ws.Range("A1:A300").AutoFill Destination:=ws.Range("A1:A15000"), Type:=xlFillCopy
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Stores Modified"
Application.ScreenUpdating = False
        For r = 1 To lr
            With Cells(r, 1)
                .Formula = "=CONCATENATE(Stores!A" & r & ","" - "",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))"
                .Value = .Value
            End With
        Next r
Application.ScreenUpdating = True
End Sub
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,396
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Ooops....missed the bit about no spaces

Code:
Sub MM1()
Dim c As Integer, lr As Long, r As Long, ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("Stores")
ws.Range("A1:A300").AutoFill Destination:=ws.Range("A1:A15000"), Type:=xlFillCopy
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Stores Modified"
Application.ScreenUpdating = False
        For r = 1 To lr
            With Cells(r, 1)
                .Formula = "=CONCATENATE(Stores!A" & r & ",""-"",RANDBETWEEN(100,999),CHAR(RANDBETWEEN(65,90)),CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(1000,9999))"
                .Value = .Value
            End With
        Next r
Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,133,527
Messages
5,659,335
Members
418,497
Latest member
VAllen79

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