Solved

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

Posted on 2009-03-31
6
493 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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 

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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Suggested Solutions

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

759 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now