CODEWITHSUNDEEP
excel
Joseph.Scott.Garza
Joseph.Scott.Garza

Reputation: 133

MS Excel: macro inquiry for array

lets say in column A:Row 2, I have a score of 45 and in column B, I have the amount of people that got that score. what i then want to do is on column D, output that score X amount of times. x=repitition.

in the exmaple 5 people got a score of 45 so in column D i want to insert 5 scores of 45. then I see in column A:Row2 3 people got a score of 46 then after the last 45, in column D I want to append 46 3 times.. and so on..

Could someone show me how to do this?

enter image description here

Upvotes: 0

Views: 98

Answers (2)

SeanC
SeanC

Reputation: 15923

Macro answer:

Sub WriteIt()
Dim lrow As Long
Dim WriteRow As Long
Dim EachCount As Long
Dim ReadRow As Long

' find last in list of numbers
lrow = Range("A1").End(xlDown).Row
'start at 2 because of headers
WriteRow = 2
ReadRow = 2

While ReadRow <= lrow
    For EachCount = 1 To Cells(ReadRow, 2)
    'repeat the number of times in column B
        Cells(WriteRow, 4) = Cells(ReadRow, 1)
        'the number in column A
        WriteRow = WriteRow + 1
    Next
    ReadRow = ReadRow + 1
    'and move to the next row
Wend
'finish when we've written them all
End Sub

it is possible with a formula, just not really recommended as it looks auful, and would be difficult to explain. It uses a Microsoft formula to count the number of unique items in the data above, and once it counts the number it is supposed to write of the number above, it moves to the next number. The formula does not know where to stop, and will put 0 when it runs out of data.

in D2, put =A2 In D3, and copied down, put

=IF(COUNTIF($D$2:D2,OFFSET($A$1,SUM(IF(FREQUENCY($D$2:D2,$D$2:D2)>0,1)),0))<OFFSET($B$1,SUM(IF(FREQUENCY($D$2:D2,$D$2:D2)>0,1)),0),OFFSET($A$1,SUM(IF(FREQUENCY($D$2:D2,$D$2:D2)>0,1)),0),OFFSET($A$1,SUM(IF(FREQUENCY($D$2:D2,$D$2:D2)>0,1))+1,0))

Upvotes: 1

chrono
chrono

Reputation: 138

Here you go:

    Sub test_scores_repitition()
        'run with test scores sheet active
        r = 1
        dest_r = 1
        Do While Not IsEmpty(Range("a" & r))
            If IsEmpty(Range("b" & r)) Then Range("b" & r).Value = 0 'if there's no quantity listed for a score, it assumes zero
            For i = 1 To Range("b" & r).Value
                Range("d" & dest_r).Value = Range("a" & r).Value
                dest_r = dest_r + 1
            Next i
            r = r + 1
        Loop
    End Sub

Upvotes: 1

Related Questions