Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA -- Executing One Macro for Multiple Referenced Rows 2

Status
Not open for further replies.

yabby24

Chemical
Nov 2, 2015
10
0
0
US
Hello,

I am still relatively new to coding and creating macros/code in Excel VBA, so please excuse the lack of knowledge and/or coding language.

I have 750 rows of information with columns staying static. I need to send information in certain cells to another worksheet within the same workbook; however, one worksheet is not in the same format as the other, so a bulk copy/paste will not work here.

I thought perhaps it may be possible for the user to "type" what row number would need to be copied/sent to another worksheet, but I'm having trouble with how to formulate how this may work. I also tried to do this in another tab, "manually" having each part of the macro edit and then having a macro create a macro with the new code, but this is also difficult, if not impossible to execute.

Here is part of my code that works for an individual row (row 9), but each row would need to change, depending on user input:

Sub Line_SendtoST()
' Line_SendtoST Macro

' Copy Tag Number
Sheets("Multi Test").Select
Range("C9").Select
Selection.Copy
Sheets("Single Test").Select
Range("H4:L4").Select
ActiveSheet.Paste

' Copy Pressure & Units
Sheets("Multi Test").Select
Range("O9").Select
Selection.Copy
Sheets("Single Test").Select
Range("L12:O12").Select
ActiveSheet.Paste

Sheets("Multi Test").Select
Range("O8").Select
Selection.Copy
Sheets("Single Test").Select
Range("P12").Select
ActiveSheet.Paste

' Copy Temperature & Units
Sheets("Multi Test").Select
Range("P9").Select
Selection.Copy
Sheets("Single Test").Select
Range("L13:O13").Select
ActiveSheet.Paste

Sheets("Multi Test").Select
Range("P8").Select
Selection.Copy
Sheets("Single Test").Select
Range("P13").Select
ActiveSheet.Paste

End Sub

Any thoughts on how to use relative references, dynamic referencing, or other ways to get a single row to copy over based on user input/selection?

Thank you!
 
Replies continue below

Recommended for you

Hi,

1) Might be beneficial to post a representative sample of your table and the target sheet. Heck, why not upload your workbook?

2) What is significant about row 9 (and row 8) in Multi Test in the context of where its going to Single Test?

3) What is significant about other rows?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Hello,

This code replicates your code for Row 9. I have then made some assumptions:

Column C on multi test has data every other row so the next macro copies:

C11 to H15:L15
O11 to L23:O23
O10 to P23
P11 to L24:O24
P10 to P24

Code:
Sub COPY_OVER()
    Application.ScreenUpdating = False
    With Sheets("Multi Test")
        For MY_ROWS = 9 To .Range("C" & .Rows.Count).End(xlUp).Row Step 2
'COPY TAG NUMBER (C9 to H4:L4)
            .Range("C" & MY_ROWS).Copy
            With Sheets("Single Test")
                MY_NEXT_ROW = .Range("L" & .Rows.Count).End(xlUp).Row + 2
                If MY_NEXT_ROW < 4 Then MY_NEXT_ROW = 4
                .Range("H" & MY_NEXT_ROW & ":L" & MY_NEXT_ROW).PasteSpecial (xlPasteValues)
            End With
'COPY PRESSURE & UNITS (O9 to L12:O12)
            .Range("O" & MY_ROWS).Copy
            With Sheets("Single Test")
                MY_NEXT_ROW = .Range("L" & .Rows.Count).End(xlUp).Row + 2
                .Range("L" & MY_NEXT_ROW + 6 & ":O" & MY_NEXT_ROW + 6).PasteSpecial (xlPasteValues)
            End With
'(O8 to P12)
            .Range("O" & MY_ROWS - 1).Copy
            Sheets("Single Test").Range("P" & MY_NEXT_ROW + 6).PasteSpecial (xlPasteValues)
'COPY TEMP & UNITS (P9 to L13:O13)
            .Range("P" & MY_ROWS).Copy
            With Sheets("Single Test")
                MY_NEXT_ROW = .Range("L" & .Rows.Count).End(xlUp).Row
                .Range("L" & MY_NEXT_ROW + 1 & ":O" & MY_NEXT_ROW + 1).PasteSpecial (xlPasteValues)
            End With
'P8 to P13
            .Range("P" & MY_ROWS - 1).Copy
            Sheets("Single Test").Range("P" & MY_NEXT_ROW + 1).PasteSpecial (xlPasteValues)
        Next MY_ROWS
    End With
    Application.ScreenUpdating = True
End Sub

Post back with your requirements or how this macro is wrong.

----------------------------------
Hope this helps.
----------------------------------

been away for quite a while
but am now back
 
Hi all,

Thank you for the responses. I figured it would be easiest to upload a snippet of what I am trying to do. I'd like to enter a row on the MultiTest Tab cell D2, and have that row's information be pasted into the Single Test Tab. My current macro (shown above, with slightly altered reference rows) is in this workbook, for Line 1, Row 9. Let me know if this makes it more clear--I really appreciate the help.

Thank you!
 
 http://files.engineering.com/getfile.aspx?folder=c9799340-75bf-4039-aab4-e5575235630b&file=Copy_of_TW_Tool.xlsm
yabby24, I changed some stuff in your workbook.

1) Added several Named Ranges to a) make whats happening more understandable and 2) make coding simpler:

Multi Test
SelectedLineNbr: The place in Multi Test where you enter a line number
TagNo: The range of Tag No rows 9-18
Press: The pressure range rows 9-18
Temp: The temperature range rows 9-18

Single Test
Tag_No: The selected tag no
Pressure: The selected pressure
Temperature: The selected temperature

2) removed unused Modules

3) added two pieces of code
first in the Multi Test sheet object added an event that calls your macro whenver you change the SelectedLineNbr...
Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, [SelectedLineNbr]) Is Nothing Then
        Line_SendtoST
        Sheets("Single Test").Activate
    End If
End Sub

The made your macro simpler
Code:
Option Explicit

Sub Line_SendtoST()
'SkipVought Nov 15, 2016
'Used Named Ranges to define single cells and ranges of data
'the procedure is called by the Worksheet_Change event on Multi Test
'    when the SelectedLineNbr cell is changed

    Dim xl As Application
    
    Set xl = Application
    
    ' Line_SendtoST Macro
    
    [Tag_No.] = xl.Index([TagNo], [SelectedLineNbr], 1)
    
    [Pressure] = xl.Index([Press], [SelectedLineNbr], 1)
    
    [Temperature] = xl.Index([Temp], [SelectedLineNbr], 1)
    
    Set xl = Nothing
 End Sub

Hope this helps.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
 http://files.engineering.com/getfile.aspx?folder=65e86b67-dfbb-4a6b-8126-a2ed0cf9067f&file=Copy_of_TW_Tool.xlsm
This is exactly what I needed! I didn't know you could use the named ranges in VBA--that made it so much simpler! THANK you so very much for all of your help, I understand so much better now and the larger sheet is fully functional.

Thanks again!
 
...and you really didn't need VBA, as you could have used the corresponding formulas directly in each of the cells...
[tt]
Tag_No.: =INDEX(TagNo,SelectedLineNbr,1)
Pressure: =INDEX(Press,SelectedLineNbr,1)
Temperature: =INDEX(Temp,SelectedLineNbr,1)
[/tt]

However, if you do, you must delete the event code in the Multi Test Sheet Object.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
So, yabby24, why even have a selection on Multi Test? Why not an in-cell drop down right on Single Test, for instance, in the Tag No. Cell. Just list all the Tag Nos from the Multi Test sheet. When the user selects a Tag No from the drop down, use that value to fill in the blanks for Pressure and Temperature with an INDEX & MATCH. Pretty simple and it keeps the user on the sheet of interest, it would seem to me.

I just can't put some thing down. My mind yearns for better solutions, at least within the scope of my capabilities.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Status
Not open for further replies.
Back
Top