VBA copy value multiple times based upon number of rows and loop

[ruannpreger]

Hi,

I would like to make the VBA below more efficient.
In my simplified example i have 5 rows populated.
Column D has 5 values; lets say
D1 = AAA
D2 = BAH
D3 = KLM
D4 = TRE
D5 = BHG

so vba counts the number of rows ( which is 5) and then copy value in D1 ( which is AAA) 5 times in col H, next it copies values D2 ( BAH) 4 times to col i.
by changing the vba manually, it works however in real i have over 100 values.

Now i would like to have this / everything only in col H underneath eachother and preferably more efficient.

Sub test()
Dim MyCount As Long
MyCount = Range("A" & Rows.Count).End(xlUp).Row
Dim MyVal As String
If MyCount > 0 Then MyVal = Range("d1").Text
Range("h1:h" & MyCount) = MyVal

MyCount2 = Range("A" & Rows.Count).End(xlUp).Row - 1
Dim MyVal2 As String
If MyCount2 > 0 Then MyVal2 = Range("d2").Text
Range("i1:i" & MyCount2) = MyVal2

MyCount3 = Range("A" & Rows.Count).End(xlUp).Row - 2
Dim MyVal3 As String
If MyCount3 > 0 Then MyVal3 = Range("d3").Text
Range("j1:j" & MyCount3) = MyVal3
End sub

it should result in :
Col H

AAA
AAA
AAA
AAA
AAA
BAH
BAH
BAH
BAH
KLM
KLM
KLM

thanks.

 

[Fluff]

How about

Sub ruannpreger()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, rr As Long, nr As Long
   
   Ary = Range("D1", Range("D" & Rows.Count).End(xlUp)).Value2
   ReDim Nary(1 To UBound(Ary) ^ 2, 1 To 1)
   For r = 1 To UBound(Ary)
      For rr = r To UBound(Ary)
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
      Next rr
   Next r
   Range("H1").Resize(nr).Value = Nary
End Sub

 

[ruannpreger]

great! while testing it I noticed that the row count should be deducted with 1. Meaning that when there are 5 rows, it should multiply with 4 (instead of 5) and then with 3 and then with 2. Where do i put -1 in the code?

 

[Fluff]

If you do that what happens to the last value in the column?

 

[ruannpreger]

sorry i do not understand your question.

 

[Fluff]

if you copy the 1st value 4 times, the 2nd 3times, the 3rd 2times, the 4th once. Where does that leave the 5th value?

 

[ruannpreger]

the 5th can go, it is not needed

 

[Fluff]

In that case try

Sub ruannpreger()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, rr As Long, nr As Long
   
   Ary = Range("D1", Range("D" & Rows.Count).End(xlUp)).Value2
   ReDim Nary(1 To UBound(Ary) ^ 2, 1 To 1)
   For r = 1 To UBound(Ary)
      For rr = r To UBound(Ary) - 1
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
      Next rr
   Next r
   Range("H1").Resize(nr).Value = Nary
End Sub

 

[ruannpreger]

perfect!

 

[Fluff]

You're welcome & thanks for the feedback.