macro to copy a value multiple times depending on value in adjacent column?

  • Thread starter Thread starter jenlong
  • Start date Start date
J

jenlong

Hello All,
I would love it if someone could help me figure this one out.

I have a list of values like the example below. I need to copy the
values in column A into a new column on another worksheet, but I need
to paste each value the number of times represented by column B.

Column A Column B
345442 3
154468 4
223399 2
....

I want the result to look like this:

New Column, New worksheet
345442
345442
345442
154468
154468
154468
223399
223399
....

I have a massive list that I need to do this to (1286 rows) and the
output will end up over 10,000 rowes (but less than excel max).

Can anyone help me with a macro for this?

Thanks!
jlo
 
One way...

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim HowMany As Long
Dim DestCell As Range

Set CurWks = Worksheets("sheet1")
Set NewWks = Worksheets.Add
Set DestCell = NewWks.Range("A1")

With CurWks
FirstRow = 1 'no headers??
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
HowMany = .Cells(iRow, "B").Value
DestCell.Resize(HowMany, 1).Value = .Cells(iRow, "A").Value
Set DestCell = DestCell.Offset(HowMany, 0)
Next iRow
End With
End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

You may want to add some validity checks--like the value in column A is a number
bigger than 0.
 
jlo

One way:

Option Explicit
Sub CopyValuesXTimes()
Dim ValuesToCopy As Long
Dim DataToCopy As Variant
Dim TimesToCopy As Long
Dim i As Long
Dim j As Long
Dim TargetRow As Long

' set the row counter for the target sheet
TargetRow = 1
' establish how many values to be copied
ValuesToCopy = Range("A65536").End(xlUp).Row
' repeat as many times as there are values to be copied
For i = 1 To ValuesToCopy
' save the value and the counter
DataToCopy = Range("A" & i).Value
TimesToCopy = Range("B" & i).Value
' repeat the copy as many times as necessary
For j = 1 To TimesToCopy
With Sheets("Sheet3")
.Range("A" & TargetRow) = DataToCopy
' increment the row counter in the target sheet
TargetRow = TargetRow + 1
End With
Next 'j
Next 'i
End Sub

Amend the name of the target sheet as required.

The sheet with the data must be selected when you start.

No error checking so it will probably fail if it finds a "counter" that is
not numeric

Regards

Trevor
 
jlo

You can use this macro.................

First make a copy of the worksheet and run on that sheet.

Sub Add_Rows()
'col B contains a number
'col A contains data
'this routine copies A according to number in B
Dim RowNdx As Long
Dim lastrow As Long
Dim n As Long
Dim x As Long
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
For RowNdx = lastrow To 1 Step -1
n = Cells(RowNdx, 2).Value
Rows(RowNdx + 1).Resize(n - 1).EntireRow.Insert Shift:=xlShiftDown
For x = 1 To 2
Cells(RowNdx, x).Resize(n, 1) = Cells(RowNdx, x).Value
Next x
Next RowNdx
Columns(2).Clearcontents
End Sub


Gord Dibben MS Excel MVP
 
Back
Top