Macro to copy from Sh1 (triggered by an entry), paste in Sh2 but also integrating it into existing code

Raceman

Board Regular
Joined
Mar 11, 2010
Messages
64
Hi: I need help with writing a new macro and integrating it into some existing code. My existing code works well for creating an auto hyperlink, from one sheet to another, triggerered by a dropdown value in Sh1 column K.

I'm trying to add vba code to have the same trigger do a copy of cells in column A and B from Sh1 and paste to Sh2. The info from these 2 cells will go into Sh2 A and B on the same row as the hyperlink points to (which is the next available open Cell in column A).


Sh1 is named MAD_CAT
Sh2 is named CABLE_MATRIX

Here is my tested hyperlink code :
HTML:
'This is option A to add hyperlink automatically. When "Cable Assy..." in column k dropdownn is selected then
'a hyperlink is automatically created which links to the next blank cell A on the Cable Matrix Worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rws As Long, sh As Worksheet
    Set sh = Worksheets("CABLE_MATRIX")
    With sh
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
    If Target.Count = 1 And Target.Column = 11 Then
       If InStr(Target, "Cable Assy") <> 0 Then
           ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(0, 5), Address:="", SubAddress:= _
                                      "CABLE_MATRIX!A" & Rws, TextToDisplay:="CABLE_MATRIX!A" & Rws
     End If
     
    End If
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
Try:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Rws As Long
    If Target.Count = 1 And Target.Column = 11 Then
        If InStr(Target, "Cable Assy") > 0 Then
            Rws = Worksheets("CABLE_MATRIX").Cells(Rows.Count, "A").End(xlUp).Row + 1
            ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(, 5), Address:="", _
                        SubAddress:="CABLE_MATRIX!A" & Rws, TextToDisplay:="CABLE_MATRIX!A" & Rws
            Sheets("CABLE_MATRIX").Range("A" & Rws).Resize(, 2).Value = Target.Offset(, 1 - Target.Column).Resize(, 2).Value
        End If
    End If
End Sub
 

Raceman

Board Regular
Joined
Mar 11, 2010
Messages
64
Thank you for your help, I apologize about the cross posting...I was in such a hurry I didn't review the rules well enough. And was just trying to maximize visability into my problem. Your solution works well, I truely appreciate it.
 

Raceman

Board Regular
Joined
Mar 11, 2010
Messages
64
Your code works well, can I add a slight wrinkle to it? When the copy and paste from Sh1 A and B to Sh2 A and B occurs, can you show me how to modify the code to enter the word "Combined" in Column C same row?
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
This should now add the word combined to the destination sheet, col. C
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rws As Long
    If Target.Count = 1 And Target.Column = 11 Then
        If InStr(Target, "Cable Assy") > 0 Then
            Rws = Worksheets("CABLE_MATRIX").Cells(Rows.Count, "A").End(xlUp).Row + 1
            ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(, 5), Address:="", _
                        SubAddress:="CABLE_MATRIX!A" & Rws, TextToDisplay:="CABLE_MATRIX!A" & Rws
            Sheets("CABLE_MATRIX").Range("A" & Rws).Resize(, 2).Value = Target.Offset(, 1 - Target.Column).Resize(, 2).Value
     Sheets("CABLE_MATRIX").Range("C" & Rws) = "Combined"
        End If
    End If
End Sub
 

Forum statistics

Threads
1,136,780
Messages
5,677,688
Members
419,712
Latest member
LearningCR

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
Top