Results 1 to 9 of 9
  1. #1
    4 Star Lounger
    Join Date
    Dec 2003
    Location
    Perth, Western Australia, Australia
    Posts
    487
    Thanks
    75
    Thanked 2 Times in 1 Post

    Help with code (or other suggestions)

    Hi All,

    I'm after some assistance from the experts once again

    I've attached a sample that should explain what I'm trying to achieve.

    But basically, I'm trying to copy values from one worksheet (Lookup) into various cells in to another worksheet (Action) based on selected heading types rather than using vlookup as I need to edit the text once it enters the respective cells. I guess that this would require some code that I'm still trying to master.

    I hope that makes sense, I think the attached should indicate what I'm tring to achieve (I hope)

    Thanks for any assistance or suggestions that you may have.

    Regards
    Attached Files Attached Files

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Verada,

    The following code will take the selection you make in Column D from you data validation dropdown and pull over the related data from the Lookup sheet (into "E" and "H"). I have set it up for the range D4 to D100 but it is easily expandable to what ever you like. Extend your data validation as well.

    HTH,
    Maud

    Place in the worksheet module (Action):
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("D4:D100")) Is Nothing Then
            With Worksheets("Lookup")
                On Error GoTo errorhandler
                x = WorksheetFunction.Match(Target.Value, .Range("E:E"), 0)
                Target.Offset(0, 1) = .Cells(x, "F")
                Target.Offset(0, 4) = .Cells(x, "H")
            End With
        End If
    Exit Sub
    errorhandler:
        MsgBox "No matched found"
    End Sub
    Attached Files Attached Files

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    verada (2016-11-11)

  4. #3
    4 Star Lounger
    Join Date
    Dec 2003
    Location
    Perth, Western Australia, Australia
    Posts
    487
    Thanks
    75
    Thanked 2 Times in 1 Post
    Thanks Maud - you have done is again.

    Thats just what I need.

    One other question, how can some code be added to toggle the above code on and off and may be but "On" or "off in say A1

    Thank once more

    Regards

  5. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Verada,

    Place an active X command button over cell A1 on the Action sheet and then make sure it is called CommandButton1 and the caption set to "Code: ON". Add the following code for the CommandButton1_Click() event and then change one line in the previous code highlighted in blue. This will toggle the code as active or inactive according to the command button's caption.

    HTH,
    Maud


    In the Action sheet's worksheet module
    Code:
    Private Sub CommandButton1_Click()
    If CommandButton1.Caption = "Code: On" Then
        CommandButton1.Caption = "Code: Off"
    Else:
        CommandButton1.Caption = "Code: On"
    End If
    End Sub
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    If CommandButton1.Caption = "Code: Off" Then Exit Sub
    If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("D4:D100")) Is Nothing Then
            With Worksheets("Lookup")
                On Error GoTo errorhandler
                x = WorksheetFunction.Match(Target.Value, .Range("E:E"), 0)
                Target.Offset(0, 1) = .Cells(x, "F")
                Target.Offset(0, 4) = .Cells(x, "H")
            End With
        End If
    Exit Sub
    errorhandler:
        MsgBox "No matched found"
    End Sub

  6. The Following User Says Thank You to Maudibe For This Useful Post:

    verada (2016-11-12)

  7. #5
    4 Star Lounger
    Join Date
    Dec 2003
    Location
    Perth, Western Australia, Australia
    Posts
    487
    Thanks
    75
    Thanked 2 Times in 1 Post
    Thanks Maud - perfect

    Your assistance is very much appreciated!!

  8. #6
    4 Star Lounger
    Join Date
    Dec 2003
    Location
    Perth, Western Australia, Australia
    Posts
    487
    Thanks
    75
    Thanked 2 Times in 1 Post
    Hi Maud

    Me again!

    Is it possible to modify this code so when the data comes across it retains it original formatting?

    Thanks for your assistance once again

    Regards

  9. #7
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Hi verada,

    That becomes a copy paste process

    In the worksheet module:
    Code:
    Private Sub CommandButton1_Click()
    '------------------------------------
    'TOGGLE CODE OFF/ON USING CAPTION
    If CommandButton1.Caption = "Code: On" Then
        CommandButton1.Caption = "Code: Off"
    Else:
        CommandButton1.Caption = "Code: On"
    End If
    End Sub
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    '------------------------------------
    'TEST FOR CODE TOGGLE
    If CommandButton1.Caption = "Code: Off" Then Exit Sub
    '------------------------------------
    'TEST IF CODE SHOULD RUN WITH SELECTED CELL
    If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("D4:D100")) Is Nothing Then
            With Worksheets("Lookup")
                On Error GoTo errorhandler
                x = WorksheetFunction.Match(Target.Value, .Range("E:E"), 0)
    '------------------------------------
    'RETRIEVE RESULT1
                Sheets("Lookup").Select
                .Cells(x, 6).Select
                Selection.Copy
                Sheets("Action").Select
                Target.Offset(0, 1).Select
                ActiveSheet.Paste
    '------------------------------------
    'RETRIEVE RESULT2
                Sheets("Lookup").Select
                .Cells(x, 8).Select
                Selection.Copy
                Sheets("Action").Select
                Target.Offset(0, 4).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
            End With
        End If
    Application.ScreenUpdating = False
    Exit Sub
    '------------------------------------
    'NO MATCH (IF NOT USING DATA VALIDATION)
    errorhandler:
        MsgBox "No matched found"
        Application.ScreenUpdating = False
    End Sub
    HTH,
    Maud

  10. The Following User Says Thank You to Maudibe For This Useful Post:

    verada (2016-11-20)

  11. #8
    4 Star Lounger
    Join Date
    Dec 2003
    Location
    Perth, Western Australia, Australia
    Posts
    487
    Thanks
    75
    Thanked 2 Times in 1 Post
    Hi Maud

    Just right!!

    Thanks again

    Regareds

  12. #9
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Let me know if you need any more help,
    Maud

  13. The Following User Says Thank You to Maudibe For This Useful Post:

    verada (2016-11-21)

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •