Paste text according to value in corresponding cell

[Kashyap]

Hi,

in Col B I have names, something like below..

Col B
Name
ABC
MNO
MNO
MNO
MNO
XYZ
XYZ
UTV
ABC
MNO
XYZ
XYZ
UTV
ABC
MNO
XYZ
XYZ
UTV
ABC
XYZ
UTV
ABC
XYZ
UTV
ABC
XYZ
UTV
ABC
XYZ
UTV
ABC
XYZ
UTV

I need to insert same name in Col K as per value in Col F. That is I have
Unique Name list in Cil E and value in Col F..

ColE ColF
ABC 2
MNO 2
XYZ 3
UTV 2

If, F1=2 then I need E1 (ABC) Twice (In K1 & K2) and accordingly for F3=3,
then E3 (XYZ) should come in after ABC & MNO in ColK.

Pls assist

Thnaks

 

[Chip Pearson]

If you already have the distinct items and their counts in columns E
and F, use the following code. It will create a list beginning in cell
K1 of the distinct elements in E, duplicated the number of times as
specified in column F.

Sub BBB()
Dim R As Range
Dim Dest As Range
Dim N As Long
Dim M As Long

Set R = Range("E1")
Set Dest = Range("K1")
Do Until R.Text = vbNullString
N = R(1, 2)
For M = 1 To N
Dest = R.Text
Set Dest = Dest(2, 1)
Next M
Set R = R(2, 1)
Loop
End Sub


If all you have is the original data in column B and you need to
create the list of distinct elements and their counts in columns E and
F, use the following code.

Sub AAA()
Dim RR As Range
Dim R As Range
Dim Dest As Range
Dim C As New Collection
Dim V As Variant
Dim N As Long
' RR is range of all original cells.
Set RR = Range("B1:B10") '<<< CHANGE
' Dest is the destination for the calculated data.
Set Dest = Range("E1") '<<< CHANGE
' Loop through all cells in RR.
For Each R In RR.Cells
' Skip empty cells.
If R.Value <> vbNullString Then
On Error Resume Next
Err.Clear
' Attempt to add R.Text to C. If
' we have not encountered R.Text before,
' the Add will succeed and Err.Number will
' be zero. If we have already seen R.Text,
' it will be in C and the Add will fail
' and set Err.Number to a non-zero value.
' This prevents duplicates in the output
' list.
C.Add R.Text, R.Text
If Err.Number = 0 Then
' Put the value in the destination cel.
Dest.Value = R.Text
' Count the number of R.Text values in RR.
N = Application.CountIf(RR, R.Text)
' Put the total next to the text value.
Dest(1, 2).Value = N
' Move the destination down one row.
Set Dest = Dest(2, 1)
End If
End If
Next R
End Sub


Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Kashyap]

Hey, Thanks a lot.. Works exactly the way I wanted..