VBA to transfer certain rows to another worksheet based on cell value

Mike62

New Member
Joined
Jul 14, 2016
Messages
8
Hello - I've done lots of work in Excel, but just some limited experience with VBA, so need some help with this. I'm sure this has been asked before, but I'm not having success on what I want to program. I have an inventory list on sheet1 ("Sign1") with about 400 products (rows) of product info in 4 columns (Col"A" is for the quantity, Col"B" is the product code, Col"C" is the product description & Col "D" is the price). If any of the items is selected (i.e. value in column A >0), then I want the rows that have been selected by the quantity, to copied into Sheet2. This has to loop so that the macro runs down column "A" of sheet1 & only those rows selected, get copied one after the other onto Sheet2 (Summary), starting in cell B12. End result, say, info on rows 3,5,12,15 & 20 of sheet1, get put into rows 12 through 16 on sheet 2. I'm sure there's a simple VBA that can accomplish this. Thanks!
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
When you say selected cells, I'm assuming just the cells with a quantity greater than 0

Code:
r = 12
With Sheets("Sign1")
    For Each c In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
        If c.Value > 0 And IsNumeric(c.Value) Then
            Sheets("Sheet2").Range("B" & r & ":E" & r).Value = .Range("A" & c.Row & ":D" & c.Row).Value
            r = r + 1
        End If
    Next
End With
 
Upvote 0
You have some options.
1. You can make a macro and attach it to a command button so that a user can use the Ctrl key to make multiple selctions of items in a single column, or entire rows but it must be one or the other, not a combination. When the user has completed their selection, they can click the button and activate the macro to execute the copy action.

2. You can use an worksheet event macro which will activate dependent upon which type event you choose, to execute the copy as the user makes changes to a cell or moves from one cell to another, or goes to a different worksheet. But again, it must be one type of event and not a combination.

There are numerous approaches to doing what you want. But you must first decide in your own mind how you want the user to be able to activate the macro and at what point you want the copy transaction to occur. You need to be clear about what the user is selecting, eg. a cell, a row, a column and which rows and columns by letter or number, rather than header title. The original post contains most of the necessar information to formulate a macro, but it is unclear how you expect the user to make the selection and when the copy transaction is to occur.

Here is a Worksheet_SelectionChange procedure that will activate based on selection changes on the worksheet.
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Columns.Count > 1 Then Exit Sub
Application.EnableEvents = False
    If Sheets("Summary").Range("B12") = "" Then
        Range("A" & Target.Row).Resize(1, 4).Copy Sheets("Summary").Range("B12")
    Else
        Range("A" & Target.Row).Resize(1, 4).Copy Sheets("Summary").Cells(Rows.Count, 2).End(xlUp)(2)
    End If
Application.EnableEvents = True
End Sub

This automatically runs as the user makes selections. To install the code, right click the name tab of the sheet where the user will make selections. Click 'View Code' in the pop up mehnu, then copy and paste the code into the code window of the vbEditor. Close the vbEditor and save your workbook as a macro enabled workbook to preserve the code. The code will now execute for any selection change on the worksheet. To prevent the code from running, Click Developer on the ribbon, then click the design mode icon, (Triangle and ruler).
 
Last edited:
Upvote 0
Hi! After my initial post, I was thinking that it would be easier to just copy the entire 'selected' row(s) from Sheet1 (named "Sign1") to Sheet2 (named 'Summary"), as Col"E" has a formula to total quantity ("A") x unit price ("D"). Also, I want the user to select what is needed, then post only those selected items on Sheet1 to Sheet2 after the last selection has been made. So, for example, say only items on Sheet1,rows 4,6,11,44,55 & 112 have a value of 1 or greater, then everything in row 4 copies to, say, sheet2, row12, 6 to 13, 11 to 14 etc... until all (in this case 6) items have been copied. I think copying the row would make the macro easier. Thanks!
 
Upvote 0
It appears that what you need is a macro which can be attached to a button, so that when the user is satisfied that they have completed the selections they can click the button and execute the copy transaction. Here is a macro that can do what you describe.
Code:
Sub copySomeRows()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range
Set sh1 = Sheets("Sign1")
Set sh2 = Sheets("Summary")
Set rng = Selection.EntireRow
If sh2.Range("A12") = "" Then
    rng.Copy sh2.Range("A12")
Else
MsgBox rng.Address
    rng.Copy sh2.Cells(Rows.Count, 1).End(xlUp)(2)
End If
End Sub
You can attach this to a button by copying the code to the standard code module1. (Alt + F11) and double click 'Module1' in the small Projects window at upper left in the vb Editor screen. If the code window is dark, click Insert on the Editor menu bar, then click Module. After the code is installed, close the vb Editor and in the Developer menu bar, click Insert. Click the command button in the Form Controls toolbox, move the cursor cross hair to the spot on sheet Sign1 where you want the button to appear and left click. A dialog box should appear with an option to assign a macro, click that option and complete the items in the next dialog box to finish the attachment. Click OK and you should now be able to run the macro when the button is clicked. If you elect to use an Active-x command button, the code would need to be in the sheet code module and the title line of the macro would need to be changed to a button#_click type title.

Your workbook must be saved as a .xlsm macro enabled file or your code will be lost when you close the workbook.
 
Last edited:
Upvote 0
Hello - thanks for the macro you provided, but it didn't do what I wanted.
sheet 1 info, after selections:

Qty Code Description price total
1 1 123 .081 Alum Sht 5052 H32 Width 48"(36lb) 1.00 $1.00
2 456 .125 Alum Sht 5052 H32 Width 48"(56 Lb) 2.00
3 3 789 .125 Alum Sht 5052 H32 Width 48"(71 lb) 3.00 $9.00
.....
5 4 654 1 1/2x 1 1/2 x 1/8 AL Ang 6061-T6 Width Length 20' (8 lb) 5.00 $20.00
6 987 2x2x1/8 AL Ang. 6061-T6 Width Length 20' (11 lb) 25.85
 
Upvote 0
Hi - ignore previous, hit wrong key before finished typing!! Simple diagram to illustrate, sheet 1 has 400 rows, in this case only info in sheet 1 rows 1,3&15 are selected, then only the info in these 3 rows copy, into sheet 2, starting in row 12. With dealing with any combination off of sheet 1 (could be 3, 23, 113 items), need macro to go down sheet 1, column A & if any if the 400 items has a value (1 or greater), then that row copies to she

sheet 1 info, after selections:
r/c A B C D E
1 1 123 .081 Alum Sht 5052 H32 Width 48"(36lb) 1.00 $1.00
2 456 .125 Alum Sht 5052 H32 Width 48"(56 Lb) 2.00
3 3 789 .125 Alum Sht 5052 H32 Width 48"(71 lb) 3.00 $9.00
......
15 4 654 1 1/2x 1 1/2 x 1/8 AL Ang 6061-T6 Width Length 20' (8 lb) 5.00 $20.00
16 987 2x2x1/8 AL Ang. 6061-T6 Width Length 20' (11 lb) 25.85

sheet 2 info, after macro run:
r/c A B C D E
12 1 123 .081 Alum Sht 5052 H32 Width 48"(36lb) 1.00 $1.00
13 3 789 .125 Alum Sht 5052 H32 Width 48"(71 lb) 3.00 $9.00
14 4 654 1 1/2x 1 1/2 x 1/8 AL Ang 6061-T6 Width Length 20' (8 lb) 5.00 $20.00
 
Upvote 0
Hi - ignore previous as well - still getting use to this form & all its nuances!! In full this time! Simple examples to illustrate below, sheet 1 has 400 rows, in this case only info in sheet 1 rows 1,3&15 are selected, then only the info in these 3 rows copy, into sheet 2, starting in row 12. With dealing with any combination off of sheet 1 (could be 3, 23, 113 items), need macro to go down sheet 1, column A & if any if the 400 items has a value (1 or greater), then that row copies to sheet 2, so if 23 (non-consecutive) items are selected on sheet 1, then these 23 items are entered respectively starting in row12, consecutively through to row 34 of sheet 2 (for the following, I ignored the column titles, but "A" is quantity, "B" is product code, "C" is product description, "D" is unit price & "E" is total price - r/c is row/column).

sheet 1 info, after selections:
r/c A B C D E
1 1 123 .081 Alum Sht 5052 H32 Width 48"(36lb) 1.00 $1.00
2 456 .125 Alum Sht 5052 H32 Width 48"(56 Lb) 2.00
3 3 789 .125 Alum Sht 5052 H32 Width 48"(71 lb) 3.00 $9.00
4.....14 no product is selected
15 4 654 1 1/2x 1 1/2 x 1/8 AL Ang 6061-T6 Width Length 20' (8 lb) 5.00 $20.00
16 987 2x2x1/8 AL Ang. 6061-T6 Width Length 20' (11 lb) 25.85

sheet 2 info, after macro run:
r/c A B C D E
12 1 123 .081 Alum Sht 5052 H32 Width 48"(36lb) 1.00 $1.00
13 3 789 .125 Alum Sht 5052 H32 Width 48"(71 lb) 3.00 $9.00
14 4 654 1 1/2x 1 1/2 x 1/8 AL Ang 6061-T6 Width Length 20' (8 lb) 5.00 $20.00


Don't need any message box if a row is blank, just a macro to make this transfer of selected items (i.e value of 1 or > in col "A", ignoring any not selected (i.e. "" in col "A"). Am I making sense?
Thanks!
 
Upvote 0
The message box was left in error. I use them for debugging. The code below is modified to include the criteria the value in col a being > 1. I am not all that proud of this code, but it should work for you.
Code:
Sub copySomeRows()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range
Set sh1 = Sheets("Sign1")
Set sh2 = Sheets("Summary")
sh1.Activate
Set rng = Selection.EntireRow
rng.Copy sh2.Range("A12")
sh2.Range("A11", sh2.Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, "<1", xlOr, "="
sh2.Range("B12", sh2.Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
sh2.AutoFilterMode = False
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,784
Messages
6,121,536
Members
449,037
Latest member
tmmotairi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top