Solved

Excel VB to Loop a copy and paste based upon a cell value

Posted on 2009-03-31
6
497 Views
Last Modified: 2012-05-06
I have a sheet called "main" that has the following values in cells starting at cell B5.  B5 has value of ItemNumber and cell C5 is HCI-1111, etc.

ItemNumber      HCI-1111
Warehouse      HCI
OrderNumber   99999
Line Number      1
TransactionDate      3/31/2009
TransactionTime      9:46:34 AM
Quantity      1
Shipped      TRUE
SelectForShip      FALSE
PrintDate      3/31/2009
Username      CFLAXM

In a second sheet named "createData" I have the 1st row with the following headings in Column A thru T.

ItemNumber      ItemFiller      Warehouse      OrderNumber      RMANumber      Source      ControlNumber      Line Number      LevelNumber      SequenceNumber      BINNumber      TransactionDate      TransactionTime      Quantity      Cost      MfgrSeriallot      Shipped      SelectForShip      PrintDate      Username


I am looking for help in creating a VB macro that will copy the data on the "Main" sheet  Column "C" to the "createData" sheet placing the data in the corresponding columns.

Now I want to be able to control the loop by a cell value, so if I need 100 rows copied with the same data I would enter the value 100 into Cell F5 on "main" sheet.

I  know nothing about VB, I would need the script written.
0
Comment
Question by:Researcher007
  • 3
  • 3
6 Comments
 
LVL 39

Expert Comment

by:nutsch
ID: 24031184
Here is a code that will work if your title row in sheets createdata is in row 1.

Here is also the sample file I ran it on.

HTH

Thomas

Option Explicit
 
Sub Macro1()
Dim orgSht As Worksheet, destSht As Worksheet
Dim i As Long, lastRow As Long, rowIndex As Long
Dim j As Integer, lastCol As Integer
 
Application.ScreenUpdating = False
 
Set orgSht = Sheets("main")
Set destSht = Sheets("createData")
 
rowIndex = 1
 
lastRow = orgSht.Range("B65536").End(xlUp).Row
lastCol = destSht.Range("IV1").End(xlToLeft).Column
 
For i = 5 To lastRow
    If orgSht.Cells(i, 2) = "ItemNumber" Then
        rowIndex = rowIndex + 1
        destSht.Cells(rowIndex, 1) = orgSht.Cells(i, 3)
    Else
        For j = 2 To lastCol
            If destSht.Cells(1, j) = orgSht.Cells(i, 2) Then
                destSht.Cells(rowIndex, j) = orgSht.Cells(i, 3)
                GoTo nxtI
            End If
        Next
    End If
nxtI:
Next
 
Application.ScreenUpdating = True
End Sub

Open in new window

24281552.xls
0
 

Author Comment

by:Researcher007
ID: 24031935
nutsch- your code works great, it placed the data in the correct column.  The only thing it doesn't do is give me an option to replicate the data.  Perhaps this is not possible.  I need to copy that same data 100 times or however many times, it varies.   As it is now I would need to click a button the number of replications I need.  It would be nice to have a cell control the number of replications.  Perferrably a cell on the "main" sheet.
0
 
LVL 39

Expert Comment

by:nutsch
ID: 24032514
you mean you just have one item number and want to copy that line x times
OR
you have multiple item numbers and want to copy each x times.
0
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 

Author Comment

by:Researcher007
ID: 24032561
One item number and want to copy that line x times, sorry if I didn't do a good job explaining that.
0
 

Author Comment

by:Researcher007
ID: 24088974
Nutsch- are you still working on this or do I need to look at another option?
0
 
LVL 39

Accepted Solution

by:
nutsch earned 500 total points
ID: 24089528
Thanks for the reminder and sorry if I forgot you. Here is my update.

Thomas

Option Explicit
 
Sub Macro1()
Dim orgSht As Worksheet, destSht As Worksheet
Dim i As Long, lastRow As Long, rowIndex As Long, numRows As Long
Dim j As Integer, lastCol As Integer
 
Application.ScreenUpdating = False
 
Set orgSht = Sheets("main")
Set destSht = Sheets("createData")
 
rowIndex = 1
 
lastRow = orgSht.Range("B65536").End(xlUp).Row
lastCol = destSht.Range("IV1").End(xlToLeft).Column
 
numRows = InputBox("How many rows do you want?", , 1)
 
For i = 5 To lastRow
    If orgSht.Cells(i, 2) = "ItemNumber" Then
        rowIndex = destSht.Range("A65536").End(xlUp).Row + 1
        destSht.Range(destSht.Cells(rowIndex, 1), destSht.Cells(rowIndex + numRows - 1, 1)) = orgSht.Cells(i, 3)
    Else
        For j = 2 To lastCol
            If destSht.Cells(1, j) = orgSht.Cells(i, 2) Then
                destSht.Range(destSht.Cells(rowIndex, j), destSht.Cells(rowIndex + numRows - 1, j)) = orgSht.Cells(i, 3)
                GoTo nxtI
            End If
        Next
        
    End If
nxtI:
Next
 
Application.ScreenUpdating = True
End Sub

Open in new window

0

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

803 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question