worksheet_change macro

Microsoft Windows xp inside out, second...
March 14, 2010 at 22:07:53
Specs: Windows XP, pentium 4 3.00Ghz. 1gb ram
There are list of items in sheet1 col.R, sheet3 col.P and sheet4 col.T

Now, if i type pen in sheet2 col.A, i want pen to be searched in sheet1 col.R. If found copy its col. B and E corresponding to pen row to corresponding row containing pen in sheet2 col.B & C, sheet3 col.B & D and sheet1's col.B, D and E to sheet4 col.B, E & G.

Can someone write worksheet_change macro for me?

See More: worksheet_change macro

March 15, 2010 at 06:39:20
Try this in a back-up copy of your workbook. Since macros cannot be undone, I wouldn't want this to mess up your original workbook.

Assuming I've understood your column-to-column relationships correctly, this should do what you've asked.

By reading the comments in the code, you should be able to tell if I understood your goal.

Right click the sheet tab for Sheet2, choose View Code and paste this into the pane that opens.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sht1_target, sht2_target, sht3_target, sht4_target
'Check if change was made to Column A
 If Target.Column = 1 Then
'Find Target in Sheet1 Column R
  With Sheets(1).Range("R:R")
   Set sht1_target = .Find(Target, LookIn:=xlValues)
  End With
'If found, set Sheet2 B & C equal to Sheet1 B & C
   If Not sht1_target Is Nothing Then
    Sheets(2).Range("B" & Target.Row) = Sheets(1).Range("B" & sht1_target.Row)
    Sheets(2).Range("C" & Target.Row) = Sheets(1).Range("C" & sht1_target.Row)
'Find Target in Sheet3 Column P
     With Sheets(3).Range("P:P")
      Set sht3_target = .Find(Target, LookIn:=xlValues)
     End With
'If found, set Sheet3 B & D equal to Sheet1 B & C
      If Not sht3_target Is Nothing Then
        Sheets(3).Range("B" & sht3_target.Row) = Sheets(1).Range("B" & sht1_target.Row)
        Sheets(3).Range("D" & sht3_target.Row) = Sheets(1).Range("C" & sht1_target.Row)
      End If
'Find Target in Sheet4 Column T
     With Sheets(4).Range("T:T")
      Set sht4_target = .Find(Target, LookIn:=xlValues)
     End With
'If found, set Sheet4 B, E & G equal to Sheet1 B, D & E
      If Not sht4_target Is Nothing Then
        Sheets(4).Range("B" & sht4_target.Row) = Sheets(1).Range("B" & sht1_target.Row)
        Sheets(4).Range("E" & sht4_target.Row) = Sheets(1).Range("D" & sht1_target.Row)
        Sheets(4).Range("G" & sht4_target.Row) = Sheets(1).Range("E" & sht1_target.Row)
      End If
   End If
 End If
End Sub

Report •

March 16, 2010 at 00:08:16
Thats what the GOLD does mean. Fantastic! Thanks from the bottom of my heart. Bye for now.

Report •

March 16, 2010 at 01:29:31
Glad to have been of assistance.

Report •
Related Solutions

Ask Question