Repeat value N times based on the cell number

M

mychi11

Board Regular
Joined
May 11, 2020
Messages
95
Office Version
  1. 2016
Platform
  1. Windows
Hi. I have the vba code, but its giving me error when i have 0 and 0 in column A and B. Was wondering anyone can help with this??
Sub RepeatValues()

Dim x As Range, SelectedRange As Range, OutputRange As Range

Range("E:F").ClearContents
Range("E1:F1").Value = [{"Result","Sorted Data"}]

Set SelectedRange = Application.Range("A2", Range("A2").End(xlDown).End(xlToRight))
Set OutputRange = Application.Range("E2")

For Each x In SelectedRange.Rows
Occurrence = x.Range("A1").Value
xNumber = x.Range("B1").Value
OutputRange.Resize(Occurrence, 1).Value = xNumber
Set OutputRange = OutputRange.Offset(Occurrence, 0)
Next

Range("E2:F" & Range("E" & Rows.Count).End(xlUp).Row).FillRight
Range("F1", Range("F1").End(xlDown)).Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlYes

'MsgBox "A new list has been created in E column with data repeated multiple times and sorted data in F column.", vbOKOnly, "Excel by Romeo Costillas"

End Sub
Purchase Order and Budget Estimation.xlsm
ABCDEF
1OccurrencexNumberResultSorted Data
200
320A131231
420A121213
52ADS151561
62ADDS131312
7201515615616
8115134684614
9115164651
1020561561511
111456456456156132132
1200
1300
1400
Check In Item
Cell Formulas
RangeFormula
A2:A14A2='PO Item'!Q3
B2:B14B2='PO Item'!V3
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
@mychi11 Maybe a simple If ******* ?

VBA Code: 
Sub RepeatValues()

Dim x As Range, SelectedRange As Range, OutputRange As Range

Range("E:F").ClearContents
Range("E1:F1").Value = [{"Result","Sorted Data"}]

Set SelectedRange = Application.Range("A2", Range("A2").End(xlDown).End(xlToRight))
Set OutputRange = Application.Range("E2")

For Each x In SelectedRange.Rows
    Occurrence = x.Range("A1").Value
    
    If Not Occurrence = 0 Then   '***********
        xNumber = x.Range("B1").Value
        OutputRange.Resize(Occurrence, 1).Value = xNumber
        Set OutputRange = OutputRange.Offset(Occurrence, 0)
     End If
     
Next

Range("E2:F" & Range("E" & Rows.Count).End(xlUp).Row).FillRight
Range("F1", Range("F1").End(xlDown)).Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlYes

'MsgBox "A new list has been created in E column with data repeated multiple times and sorted data in F column.", vbOKOnly, "Excel by Romeo Costillas"

End Sub

Hope that helps.
 
Upvote 0
I am getting an error in this line
OutputRange.Resize(Occurrence, 1).Value = xNumber
 
Upvote 0
Try
VBA Code: 
Sub RepeatValues()

Dim x As Range, SelectedRange As Range, OutputRange As Range

Range("E:F").ClearContents
Range("E1:F1").Value = [{"Result","Sorted Data"}]

Set SelectedRange = Application.Range("A2", Range("A2").End(xlDown).End(xlToRight))
Set OutputRange = Application.Range("E2")

For Each x In SelectedRange.Rows
    Occurrence = x.Range("A1").Value
     xNumber = x.Range("B1").Value
     
    If Not (Occurrence = 0 And xNumber = 0) Then
       
        OutputRange.Resize(Occurrence, 1).Value = xNumber
        Set OutputRange = OutputRange.Offset(Occurrence, 0)
     End If
     
Next

Range("E2:F" & Range("E" & Rows.Count).End(xlUp).Row).FillRight
Range("F1", Range("F1").End(xlDown)).Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlYes

'MsgBox "A new list has been created in E column with data repeated multiple times and sorted data in F column.", vbOKOnly, "Excel by Romeo Costillas"

End Sub
 
Upvote 0
It's quite tricky. the code skip the empty cell and fails to run the rest.
Even if the cell is zero or empty
Purchase Order and Budget Estimation26.xlsm
ABCDEF
1Occurrence NumberResultSorted Data
2A131231A131231
320A131231A131231A131231
40156136A131231A131231
520dgfdgA131231A131231
610A113331A131231A131231
7A131231A131231
8A131231A131231
9A131231A131231
10A131231A131231
11A131231A131231
12A131231A131231
13A131231A131231
14A131231A131231
15A131231A131231
16A131231A131231
17A131231A131231
18A131231A131231
19A131231A131231
20 A131231A131231
21 A131231A131231
22 
Stock Out
Cell Formulas
RangeFormula
A20:A22A20=IFERROR(INDEX(Category,MATCH(#REF!,ItemName,0)),"")


Purchase Order and Budget Estimation26.xlsm
ABCDEFGH
1Occurrence NumberResultSorted Data
2A131231A131231
320A131231A131231A131231
4A131231A131231
520dgfdgA131231A131231
610A113331A131231A131231
7A131231A131231
8A131231A131231
9A131231A131231
10A131231A131231
11A131231A131231
12A131231A131231
13A131231A131231
14A131231A131231
15A131231A131231
16A131231A131231
17A131231A131231
18A131231A131231
19A131231A131231
20 A131231A131231
21 A131231A131231
22 
Stock Out
Cell Formulas
RangeFormula
A20:A22A20=IFERROR(INDEX(Category,MATCH(#REF!,ItemName,0)),"")
 
Upvote 0
If you have potential for blank cells in the range of interest then you need to modify the way the last row / end of range is being determined.

Try like the below. (Ignore the formulas I have used to set up my trial data.)

VBA Code: 
Sub RepeatValues()

Dim x As Range, SelectedRange As Range, OutputRange As Range
Dim Lastr As Long
Dim Rng As Range

Range("E:F").ClearContents
Range("E1:F1").Value = [{"Result","Sorted Data"}]

'To find last row of A:B with significant value
'need to account for formulas returning zeros and/or blanks ?

Set Rng = Intersect(UsedRange, Columns("A:B"))
    Lastr = Evaluate("max(if(" & Rng.Address & "<>"""",row(" & Rng.Address & ")))")



Set SelectedRange = Range("A2:A" & Lastr)
Set OutputRange = Application.Range("E2")

For Each x In SelectedRange.Rows
    Occurrence = x.Range("A1").Value
     xNumber = x.Range("B1").Value
     
    If Not (Occurrence = "" Or xNumber = "" Or Occurrence = 0 Or xNumber = 0) Then
       
        OutputRange.Resize(Occurrence, 1).Value = xNumber
        Set OutputRange = OutputRange.Offset(Occurrence, 0)
     End If
     
Next

Range("E2:F" & Range("E" & Rows.Count).End(xlUp).Row).FillRight
Range("F1", Range("F1").End(xlDown)).Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlYes

'MsgBox "A new list has been created in E column with data repeated multiple times and sorted data in F column.", vbOKOnly, "Excel by Romeo Costillas"

End Sub




Book1
ABCDEF
1Occurrence NumberResultSorted Data
2  A131231A131231
35A131231A131231A131231
40156136A131231A131231
56dgfdgA131231A131231
63A99931A131231A131231
700dgfdgA99931
80 dgfdgA99931
9 0dgfdgA99931
1012xzzdgfdgabcde
11xxxx0dgfdgabcde
12  dgfdgabcde
134abcdeA99931abcde
14  A99931dgfdg
15  A99931dgfdg
16  abcdedgfdg
17  abcdedgfdg
18  abcdedgfdg
19  abcdedgfdg
20  
21  
22
Stock Out
Cell Formulas
RangeFormula
A2:A9,A11:B21,B2:B10A2=IF(M2="","",M2)
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Find last row of sheet based off cell value to reference the sheet name
Replies
0
Views
468
ItalianPlatinum
I
G
  • Question Question
Copy formulas x number of times based on a cell value
Replies
5
Views
343
Joe4
Joe4
U
  • Solved
Add Specific number of rows based on cell value
2 3
Replies
23
Views
904
Utradeshow
U
A
  • Solved
Changing recorded macro to have dynamic selection of cells when trying to format a sheet.
Replies
4
Views
873
Michael M
Michael M
R
  • Solved
Excel VBA to Identify Duplicates from one Worksheet Based on Cell Value from Another Worksheet
Replies
3
Views
671
rarascon
R

Forum statistics

Threads
1,224,138
Messages
6,176,586
Members
452,738
Latest member
kylua

Share this page

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
Back
Top