A Macro to Copy Labels

Hi RobertWhite,

-open the VB Editor with ALT+F11
-then insert a new module from the menu
-paste the code

Option Explicit

Sub RecordToLabels()
Dim intRows As Integer
Dim strName As String
Dim intRecCount As Integer
Dim i As Integer, j As Integer
Dim intRecordLabelCounter As Integer

  'assuming your data start at A2 on sheet 1
  Sheets(1).Activate
  Range("A2").Select
  Selection.End(xlDown).Select
  intRows = Selection.Row
  For i = 2 To intRows
    intRecCount = Range("B" & i)
    strName = Range("A" & i)
    For j = 1 To intRecCount
      Sheets(2).Range("A" & j + 1 + intRecordLabelCounter) = strName
      Sheets(2).Range("B" & j + 1 + intRecordLabelCounter) = 1
    Next j
    intRecordLabelCounter = intRecordLabelCounter + j - 1
  Next i
End Sub

-then choose F8 to step
-or choose F5 to run

HTH:O)Bruintje

Bruintje

Thanks for this.
I have tried this but nothing seems to happen.
When I press F5, I get prompted with the "GO TO" reference.

Am I doing something wrong ?

Rob

Hi Rob,

You can download a little sample here

http://www.bredlum.com/ee_temp/sample.xls

if you got any questions just post it here

HTH:O)Bruintje

Hi, try this macro:

Public Sub Duplicate()
  Dim lngLoop As Long
  Dim lngQuantity As Long
  Dim lngRowIndex As Long
 
  Sheet2.Range("A1:B10000").ClearContents
  Sheet1.Range("A1:B1").Copy Sheet2.Range("A1:B1")
   
  lngLoop = 2
  lngRowIndex = 2
 
  While Sheet1.Cells(lngLoop, 1) <> Empty
    lngQuantity = Val(Sheet1.Cells(lngLoop, 2).Value)
    While lngQuantity > 0
      Sheet2.Cells(lngRowIndex, 1).Value = Sheet1.Cells(lngLoop, 1).Value
      Sheet2.Cells(lngRowIndex, 2).Value = 1
     
      lngQuantity = lngQuantity - 1
      lngRowIndex = lngRowIndex + 1
    Wend
    lngLoop = lngLoop + 1
  Wend
 
End Sub


CHeers

Sorry guys.

My excel and Vb skills are not the best.
How do I actually get these macros to run once copied into the MODULE ?

Regards

Rob

Either place the cursor inside the procedure, and hit <F5>, or hit <ALT>+<F8>, choose the macro (duplicate) from the list, and hit the RUN button.

CHeers

This has worked a treat.
Brilliant.

Thanks a lot.
Is it ok to accept ANGELS answer ?

Rob

o yeah of course