Worksheet Change to copy from a sheet based on values from data validation list

[Onenguyen]

Hello!

I have a workbook that contains a data validation list between G4:G31. I am looking for a macro that automatically populates H4:J30 with data from its corresponding sheet.

Example: Someone clicks on "Client Services" from the list located in the "Billing" tab. Data is copied from the Client Services tab A1:C24 to H4:J30 in the "Billing" tab. There is a sheet for every list item in the data validation list and the data will always be copied into H4:J30 on the "Billing" tab.

Thank you!

 

[Cbrine]

Why use a macro when indirect will do what you need.

Just add your sheet selection in Cell A1.

Add this to cell H4: =INDIRECT("'"&$A$1&"'!A"&ROW($H4)-3)
I4 =INDIRECT("'"&$A$1&"'!B"&ROW($H4)-3)
J4 =INDIRECT("'"&$A$1&"'!C"&ROW($H4)-3)
K4 =INDIRECT("'"&$A$1&"'!D"&ROW($H4)-3)

Now just copy them down.

HTH
Cal

 

[Onenguyen]

Why use a macro when indirect will do what you need.

Just add your sheet selection in Cell A1.

Add this to cell H4: =INDIRECT("'"&$A$1&"'!A"&ROW($H4)-3)
I4 =INDIRECT("'"&$A$1&"'!B"&ROW($H4)-3)
J4 =INDIRECT("'"&$A$1&"'!C"&ROW($H4)-3)
K4 =INDIRECT("'"&$A$1&"'!D"&ROW($H4)-3)

Now just copy them down.

HTH
Cal

Thanks for your response. I actually am using an indirect function. Here's what I have so far and it works fine, but now I need to add to the code.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Range("G4:G30"), Target) Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Worksheets("Billing Form").Range("H4:J30").Value = Sheets(Target.Value).Range("B2:E30").Value
Application.ScreenUpdating = True

End Sub


The issue I'm getting now is when I have something populated in G4 and want to choose something on G5, it replaces the data. I need it to append it to the end. I know there's the end(xlUp) function, but I don't know how to incorporate it into the code.

Example: I choose "Client Services" from G4 and it populates B2:E30 from the Client Services worksheet.

When I go to G5 and choose "Hosting Services" it REPLACES the previous values(H4:J30). I want it to find the next available row and append.

Thanks!

 

[Cbrine]

OK, so everytime you choose a new validation value, you want to append the new records to the bottom of your range on the paste sheet? If so, do this.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet, ps As Worksheet
Dim test As Range
Application.EnableEvents = False

Set ws = ActiveSheet
Set ps = ActiveWorkbook.Sheets(Target.Value)
Set test = ws.Range("A1")

If Not (Intersect(Target, test) Is Nothing) Then
    If ws.Range("H4") = "" Then
        ps.Range("B4:E30").Copy ws.Range("H4")
    Else
        ps.Range("B4:E30").Copy ws.Range("H65535").End(xlUp).Offset(1, 0)
    End If
End If

Application.EnableEvents = True
End Sub

 

[Onenguyen]

Thank you very much for taking the time to look at my issue. I pasted the code you provided and it isn't copying data from the target sheet. As a recap, validation list is in cells G4:G40. If you pick "TEST" from the list located in cell G4, it should go to the "TEST" sheet and copy B2:D30 to H4:J4 on the active sheet . If you go to the next cell below, G5, and pick "TEST2" it should copy all B2:D30 from the "TEST2" sheet and append to the data already in H4:J4


Thanks!

 

[Cbrine]

Yeah, had my ranges wrong.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet, ps As Worksheet
Dim test As Range
Application.EnableEvents = False

Set ws = ActiveSheet
Set ps = ActiveWorkbook.Sheets(Target.Value)
Set test = ws.Range("G4")

If Not (Intersect(Target, test) Is Nothing) Then
    If ws.Range("H4") = "" Then
        ps.Range("B2:D30").Copy ws.Range("H4")
    Else
        ps.Range("B2:D30").Copy ws.Range("H65535").End(xlUp).Offset(1, 0)
    End If
End If

Application.EnableEvents = True
End Sub

Try this.

 

[Cbrine]

Oh wait, I just noticed that your validation selection runs from G4:G30, so one more change.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet, ps As Worksheet
Dim test As Range
Application.EnableEvents = False

Set ws = ActiveSheet
Set ps = ActiveWorkbook.Sheets(Target.Value)
Set test = ws.Range("G4:G40")

If Not (Intersect(Target, test) Is Nothing) Then
    If ws.Range("H4") = "" Then
        ps.Range("B2:D30").Copy ws.Range("H4")
    Else
        ps.Range("B2:D30").Copy ws.Range("H65535").End(xlUp).Offset(1, 0)
    End If
End If

Application.EnableEvents = True
End Sub

 

[Onenguyen]

You're amazing! Is there anyway to have it paste special values? The cells on the active sheet have formatting that need to stay consistent. Also, say I need to delete some values from what was pasted. When I do that I get a Run Time error = Script out of range.

Thanks!

 

[Cbrine]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet, ps As Worksheet
Dim test As Range
Application.EnableEvents = False

Set ws = ActiveSheet
Set ps = ActiveWorkbook.Sheets(Target.Value)
Set test = ws.Range("G4:G40")

If Not (Intersect(Target, test) Is Nothing) Then
    If ws.Range("H4") = "" Then
        ps.Range("B2:D30").Copy
        ws.Range("H4").PasteSpecial xlPasteValues
    Else
        ps.Range("B2:D30").Copy
        ws.Range("H65535").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If
End If

Application.EnableEvents = True
End Sub

Should take care of the pasting of values only.
As far as deleting, are you deleting entire rows? I would imagine if your row deletion intersects the G4:G40 range, it would cause an error. If you highlight the data only, and delete it, you shouldn't recieve an error. I could put some error supression in that would prevent the error from occurring.

 

[Cbrine]

Here is the code with the error supression added.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet, ps As Worksheet
Dim test As Range
Application.EnableEvents = False

On Error GoTo ErrHandler
Set ws = ActiveSheet
Set ps = ActiveWorkbook.Sheets(Target.Value)
Set test = ws.Range("G4:G40")

If Not (Intersect(Target, test) Is Nothing) Then
    If ws.Range("H4") = "" Then
        ps.Range("B2:D30").Copy
        ws.Range("H4").PasteSpecial xlPasteValues
    Else
        ps.Range("B2:D30").Copy
        ws.Range("H65535").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If
End If

Application.EnableEvents = True

Exit Sub

ErrHandler:
Select Case Err.Number
   

    Case Else
    End

End Select
End Sub