Can someone help with a VBA Macro code quick?

UrBaN963

Honorary Master
Joined
Jul 27, 2016
Messages
25,031
Reaction score
22,695
Location
JHB
As per title, need help getting a VBA Macro code to work.

Can't post the actual data, but it's an excel table.


Column A__________B____________C_________________D
12345________Outlet Name_____Sales Area________Total Entries


Background: Spreadsheet has about 6 000 line items. The spreadsheet is specifying labels to be printed. Column A, B and C specifies the content for the label - ie: what must physically be printed on the label - . Column D specifies the quantity - ie: how many labels we need, how many times it should be printed.

The printer cannot read numbers so the label physically has to be reflected x amount of times so that it can print directly

The quantity specified in column D varies – it is not fixed at 50

So I need the row to be duplicated the amount specified in column D and this should be pasted into a new sheet. This needs to happen for each row. They should all be pasted directly underneath eachother.

The macro I currently have is:

Code:
sub CopyData()
Dim lRow As Long
Dim RepeatFactor As Variant

    lRow = 1
    Do While (Cells(lRow, "A") <> "")
        
        RepeatFactor = Cells(lRow, "B")
        If ((RepeatFactor > 1) And IsNumeric(RepeatFactor)) Then
                
           Range(Cells(lRow, "A"), Cells(lRow, "B")).Copy
           Range(Cells(lRow + 1, "A"), Cells(lRow + RepeatFactor - 1, "B")).Select
           Selection.Insert Shift:=xlDown
           
           lRow = lRow + RepeatFactor - 1
        End If
    
        lRow = lRow + 1
    Loop
End Sub

Can I edit this to work for what I want to do?
 
Last edited:
62 views...isn't this place full of programmers?

If I haven't provided enough info I shall provide more.

Also, full disclosure, this is to help my GF. And as you know, a happy GF makes for happy times :p
 
62 views...isn't this place full of programmers?

If I haven't provided enough info I shall provide more.

Also, full disclosure, this is to help my GF. And as you know, a happy GF makes for happy times :p

This place is filled with programmers whose eyes glaze over with horror when they see VBA
 
Ah you are sorted. Only saw it now. Much simpler way to do it but I am too late
 
Looks like you`re doing something on excel that should have been done in a database.

Excel is meant for sending sms`s not keeping track of sales records.
 
Last edited:
I was writing my own version which had two loops but then remembered that I always over complicate things - a quick Google proved me right.

Code:
Public Sub CopyData2()

    ' This routing will copy rows based on the quantity to a new sheet.

    Dim rngSinglecell As Range
    Dim rngQuantityCells As Range
    Dim intCount As Integer

    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells

    Set rngQuantityCells = Range("D1", Range("D1").End(xlDown))

    For Each rngSinglecell In rngQuantityCells

        ' Check if this cell actually contains a number

        If IsNumeric(rngSinglecell.Value) Then

            ' Check if the number is greater than 0

            If rngSinglecell.Value > 0 Then

                ' Copy this row as many times as .value

                For intCount = 1 To rngSinglecell.Value

                    ' Copy the row into the next emtpy row in sheet2

                    Range(rngSinglecell.Address).EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)

                    ' The above line finds the next empty row.

                Next

            End If

        End If
    Next

End Sub

https://stackoverflow.com/questions/25395454/excel-vba-automation-copy-row-x-number-of-times-based-on-cell-value

Just have Sheet2 Created before you run it - or add the code to add the sheet if it does not exist.
 
Last edited:
Looks like you`re doing something on excel that should have been done in a database.

Excel is meant for sending sms`s not keeping track of sales records.

You have got to be trolling :crylaugh:
 
View attachment 474018
courtesy of blixempie in the funny pictures thread.:D

I do remember that - and if you run the mail merge wizard - you can indeed send emails via Excel. I am still on the fence about smses though :crylaugh:

But if MS have their way - no doubt it will definitely be possible in the future and then the poor boys will have no where to hide! :twisted: Not even in spreadsheets.
 
Top
Sign up to the MyBroadband newsletter
X