View Full Version : [SOLVED:] Run macro for selected rows
ced0802
01-07-2016, 06:11 AM
Hi everyone,
I would like this macro to run, for the rows that I am selecting :
Sub Copypaste()
For x = 1 To 10000
If x = ThisWorkbook.Worksheets("sheet1").Cells(2, 11) Then
ThisWorkbook.Worksheets("sheet1").Cells(13, 1) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 1)
ThisWorkbook.Worksheets("sheet1").Cells(13, 5) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 2)
ThisWorkbook.Worksheets("sheet1").Cells(13, 2) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 6)
ThisWorkbook.Worksheets("sheet1").Cells(13, 3) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 7)
ThisWorkbook.Worksheets("sheet1").Cells(13, 4) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 5)
ThisWorkbook.Worksheets("sheet1").Cells(13, 7) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 9)
Range("A2:D2").Select
ActiveCell.FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF: "Ced"
ThisWorkbook.Worksheets("sheet1").Cells(4, 1) = "DATE : " & "" & Date
End If
Next x
End Sub
It is a copy paste of some cells on the lines I would select.
Thank you very much for your help.
Run the Sub from the Tools Macro menu, Add a Command Button to the Worksheet, or add a Menu Item to the Workbook
ced0802
01-07-2016, 11:00 AM
Hi,
Sorry for not ginving much details.
I have two files : - first file called "WO-clean with lines" where I'd like to paste information on row 13
- second file called "List of Materials" where I'd like to copy some information from a row. But I don't want to copy the whole row, just a few cells from the row.
GOAL : I select a row from "List of Materials" then I go back to "thisworkbook" to run my macro, and information are pasting into my chart.
This is where I am so far :
Sub Copypaste()
Set Final = ThisWorkbook.Worksheets("Sheet1")
Set Init = Workbooks("List Of materials").Worksheets("Sheet1")
LigneAvecUnPetitNom = ActiveCell.EntireRow.Row
For x = 1 To 10000
For y = 13 To 27
If x = LigneAvecUnPetitNom Then
Final.Cells(y, 1) = Init.Cells(x, 1)
Final.Cells(y, 2) = Init.Cells(x, 6)
Final.Cells(y, 3) = Init.Cells(x, 7)
Final.Cells(y, 4) = Init.Cells(x, 5)
Final.Cells(y, 5) = Init.Cells(x, 2)
Final.Cells(y, 7) = Init.Cells(x, 9)
Range("A2:D2").FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF: Ced"
Final.Cells(4, 1) = "DATE : " & "" & Date
Exit Sub
End If
Next y
Next x
End Sub
It's not working properly as when I go back to "thisworkbook" to run my macro it copies the row from "List of materials" from the row of the cell selected in "thisworkbook"
Hope it is a bit clearer :)
Thanks A LOT for your help
Put this code in the List of Materials, ThisWorkbook Code page
Private mSelectedSheet As String
Private mSelectedRow As Long
Private Sub Workbook_SheetSelectionChange(ByVal Sht As Object, ByVal Target As Range)
mSelectedSheet = Sht.Name
mSelectedRow = Target.Row
End Sub
Public Property Get SelectedSheet() As String
SelectedSheet = mSelectedSheet
End Property
Public Property Get SelectedRow() As Long
SelectedRow = mSelectedRow
End Property
Use this CopyPasteSub in a standard module in the main workbook
Sub Copypaste()
Set Final = ThisWorkbook.Worksheets("Sheet1")
Set Lom = Workbooks("List Of materials")
Set Init = Lom.Worksheets(Lom.SelectedSheet)
x = Lom.SelectedRow
y = Final.Cells(Rows.Count, 1).End(xlUp).Row + 1
If y < 13 Then y = 13
If y > 27 then
MsgBox "this Request for Writeoff is full, Please save and use a new one"
Exit Sub
End If
Final.Cells(y, 1) = Init.Cells(x, 1)
Final.Cells(y, 2) = Init.Cells(x, 6)
Final.Cells(y, 3) = Init.Cells(x, 7)
Final.Cells(y, 4) = Init.Cells(x, 5)
Final.Cells(y, 5) = Init.Cells(x, 2)
Final.Cells(y, 7) = Init.Cells(x, 9)
Final.Range("A2") = "NAME OF PERSON REQUESTING WRITE OFF: Ced"
Final.Cells(4, 1) = "DATE : " & Date
End Sub
ced0802
01-08-2016, 01:45 AM
Thank you very much for your code and the time you put.
I have a message error on
Set Init = Lom.Worksheets(Lom.SelectedSheet)
To be honnest I don't know what "Lom" is..
Thank you again!
ced0802
01-08-2016, 02:00 AM
I have this so far, which isworking. But it takes into account the row I have selected in "thisworkbook" and not in "List Of materials"
Sub Copypaste()
Dim Y As Integer
Dim Final As Worksheet, Init As Worksheet
Dim InitWB As Workbook, FinalWB As Workbook
Dim LastColumn_init As Integer, LastColumn_Final As Integer
Dim SelectedRange As Range
Set InitWB = Workbooks("List Of materials")
Set FinalWB = Workbooks("Write-off - clean with lines")
Set InitWS = InitWB.Worksheets("Sheet1")
Set FinalWS = FinalWB.Worksheets("Sheet1")
Set SelectedRange = Selection
LastColumn_itit = 9
For Each RowInSelection In SelectedRange.Rows
For Y = 13 To 27
If IsEmpty(FinalWB.Worksheets(FinalWS.Name).Cells(Y, 1)) Then
FinalWB.Worksheets(FinalWS.Name).Cells(Y, 1) = InitWB.Worksheets(InitWS.Name).Cells(RowInSelection.Row, 1)
FinalWB.Worksheets(FinalWS.Name).Cells(Y, 2) = InitWB.Worksheets(InitWS.Name).Cells(RowInSelection.Row, 6)
FinalWB.Worksheets(FinalWS.Name).Cells(Y, 3) = InitWB.Worksheets(InitWS.Name).Cells(RowInSelection.Row, 7)
FinalWB.Worksheets(FinalWS.Name).Cells(Y, 4) = InitWB.Worksheets(InitWS.Name).Cells(RowInSelection.Row, 5)
FinalWB.Worksheets(FinalWS.Name).Cells(Y, 5) = InitWB.Worksheets(InitWS.Name).Cells(RowInSelection.Row, 2)
FinalWB.Worksheets(FinalWS.Name).Cells(Y, 7) = InitWB.Worksheets(InitWS.Name).Cells(RowInSelection.Row, 9)
Exit For
End If
Next Y
Next RowInSelection
If Y - 13 > SelectedRange.Rows.Count Then MsgBox ("Error: The selected range or the selected range plus existing data contains more than (Y =) 27 - 13 rows" & vbCr & "Not all rows from selection were copied")
End Sub
Any idea how to transfer my selection/
Thank you!!
ced0802
01-08-2016, 08:01 AM
Ok so with Sam T macro, it is working :) But if I select one line.
I'm trying for 2 lines or more, but it's another story.
Thank you so much to all of you.
What is the maximum number of lines you want to select?
What is the maximum number of lines you can put on one sheet in "Write-off - clean with lines?"
What do you want to happen if you select more lines that will fit on one sheet?
ced0802
01-08-2016, 08:30 AM
Maximum line would be 8.
on Write off can put 12.
I want the same thing that this macro is doing for one line. The 2nd line selected would be pasted underneath the previous one on my main workbook
Thank you.
When you select from the List of materials, is it a block of materials or is the selection random items?
In other words, do you select, for example, rows 1, 5, & 16?
ced0802
01-09-2016, 07:56 AM
Hi,
Thank you for your message. No it would be a block (like row5,6,7,8,9).
alansidman
01-09-2016, 07:30 PM
crossposted at: http://www.excelforum.com/excel-programming-vba-macros/1120595-run-macro-for-selected-rows.html
ced0802
01-10-2016, 12:21 PM
My apoologies for the crossposted. Will edit on other forum.
Replace the two subs in Post #4 with these
Private mSelectedSheet As String 'm prefix indicate module level variable
Private mSelectedRows As String
Private Sub Workbook_SheetSelectionChange(ByVal Sht As Object, ByVal Target As Range)
'Last needed column is I (9)
mSelectedSheet = Sht.Name
mSelectedRows = Target.EntireRow.Resize(Selection.Rows.Count, 9).Address
End Sub
Public Property Get SelectedSheet() As String
'To pass sheet name to caller
SelectedSheet = mSelectedSheet
End Property
Public Property Get SelectedRows() As String
SelectedRows = mSelectedRows
End Property
Sub Copypaste()
Set Final = ThisWorkbook.Worksheets("Sheet1")
Set Lom = Workbooks("List Of materials")
Set Init = Lom.Worksheets(Lom.SelectedSheet) 'SelectedSheet calls for sheet name
Set LomSelection = Init.Range(Lom.SelectedRows) 'SelectedRows calls for range address
Y = Final.Cells(Rows.Count, 1).End(xlUp).Row + 1
If Y < 13 Then Y = 13
If Y > 25 Then
MsgBox "this Request for Writeoff is full, Please save and use a new one"
Exit Sub
End If
For X = 1 To LomSelection.Rows.Count
Final.Cells(Y, 1) = LomSelection.Cells(X, 1)
Final.Cells(Y, 2) = LomSelection.Cells(X, 6)
Final.Cells(Y, 3) = LomSelection.Cells(X, 7)
Final.Cells(Y, 4) = LomSelection.Cells(X, 5)
Final.Cells(Y, 5) = LomSelection.Cells(X, 2)
Final.Cells(Y, 7) = LomSelection.Cells(X, 9)
Y = Y + 1
If Y > 25 Then Exit For 'Bottom used row of WriteOff
Next X
Final.Range("A2") = "NAME OF PERSON REQUESTING WRITE OFF: Ced"
Final.Cells(4, 1) = "DATE : " & Date
End Sub
ced0802
01-11-2016, 11:07 AM
Woa working perfectly.
A HUGE Thank you to you SamT. I am going to try to understand how you did. I am not very familiar with the first part you code..with the private , property get selection..
Thanks a bunch !! Much appreciated.
There are three very special subs that can only be used in Object codes: Property Get, Property Let, and Property Set. Search for help on "Get". Some Objects are Class Modules, VBA UserForms, ThisWorkbook and Worksheets.
Module level Variables stay active as long as the code is running. The Worksheet_SelectionChange Sub directly sets the Module Variable's Values, and they stay active. When the CopyPaste Sub "Calls" for the Properties (Property Get Subs) the Module Variable Values are returned.
Their purpose is to allow for consistent code. Just as you can write code to set a Variable to a Range's Value
X = Range("A1")You can write Property Subs so that the rest of your code was simplified.
For example, suppose you had a Property Sub in ThisWorkbook
Property Let RequesterName (ReqName As String)
Sheets("Sheet1")Range("A2").Value = ReqName
End SubYou could write code like
ThisWorkbook.RequesterName = "NAME OF PERSON REQUESTING WRITE OFF: Ced"
Not very interesting, but suppose that you always wanted that to be just below the bottom right cell of the data
Property Let RequesterName (ReqName As String)
With Sheets("Sheet1").Range(A1").CurrentRegion
.Cells(.CellsCount).Offset(1, 0) = ReqName
End Sub
Still not too interesting, but assume that you have a parts book with several sheets of part in it. You have code in the parts book to copy selected parts to your Final Sheet in another book("WriteOffs)
In WriteOffs, ThisWorkbook Code Page, you have this code
Property Let NextItem(NewItem As Range)
Set NextRow = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).OffSet(1, -1).Resize(1, 7)
'Rows.Count, 2 for column B. Column A is not used in this example
'Offset(1, - 1) because NextRow below starts in Column A
With NextRow
.Cells(2) = NewItem.Cells(6)
.Cells(3) = NewItem.Cells(7)
.Cells(4) = NewItem.Cells(5)
.Cells(5) = NewItem.Cells(2)
.Cells(7) = NewItem.Cells(9)
End Sub
In your Parts book ThisWorkbook Code Page you have this code
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
Workbooks("WriteOffs.xlsm").NextItem = Target.EntireRow
End Sub
Those two pieces of code will let you wander from Sheet to Sheet in the Parts book, doubleclicking any cell in them to add those items to the WriteOffs Sheet, one after the other.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.