Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 509
  • Last Modified:

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

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
Researcher007
Asked:
Researcher007
  • 3
  • 3
1 Solution
 
nutschCommented:
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
 
Researcher007Author Commented:
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
 
nutschCommented:
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
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
Researcher007Author Commented:
One item number and want to copy that line x times, sorry if I didn't do a good job explaining that.
0
 
Researcher007Author Commented:
Nutsch- are you still working on this or do I need to look at another option?
0
 
nutschCommented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now