Consulting

Results 1 to 2 of 2

Thread: VBA worksheet change event

  1. #1
    VBAX Regular
    Joined
    May 2014
    Posts
    71
    Location

    VBA worksheet change event

    I have a multi-step macro that after step 4 a worksheet_change event is supposed to stop the macro until the user selects the value of A2. Then the value selected (I am testing it on 1 value “comprehensive epilepsy”, is used to call a new macro (calculations). I don’t know if the vlookup is the problem or what is going on, but it is not working as of now and I need some expert help. Thank you.

    https://app.box.com/s/7c6390rzgkfc1wycbf2j

    Entire VB:
     Sub Classify()
    Dim rngCell As Range
    Dim wsLookUp As Worksheet
     
    '  Step 1 Reformat annovar
        Range("AK1:BB1").Value = Array("Index", "Deleted", "Gene", "mRNA", "Deleted", "Deleted", "Coverage", _
                                       "Score", "A(#F,#R)", "C(#F,#R)", "G(#F,#R)", "T(#F,#R)", "Ins(#F,#R)", _
                                       "Del(#F,#R)", "SNP", "Mutation", "Frequency", "AminoAcid")
     
        Range("AL:AL, AO:AP").EntireColumn.Delete
     
        Range("AK:AY").Copy
        Range("A1").Insert
     
        Range("AP:BN").EntireColumn.Delete
     
        Range("AP1:AW1").Value = Array("Homopolymer", "Splice", "Pseudogene", "Classification", "HGMD", _
                                       "Disease", "References", "Sanger")
     
     
        Columns(3).Insert xlRight
     
        Range("C1").Value = "Inheritance"
     
        Range("1:3").Insert xlShiftDown
     
        With Range("A1:F1")
            .Value = Array("Case", "Last Name", "First Name", "Medical Record", "Gender", "Panel", "")
            .Resize(2).Interior.ColorIndex = 6
        End With
     
        '  Step 2 Select Patient
     Application.ScreenUpdating = False
        With ActiveSheet
            lastrow = Cells(.Rows.Count, "CA").End(xlUp).Row
        With Selection.Validation
            End With
            With .Range("A2").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                     xlBetween, Formula1:="=$CA$5:$CA$" & lastrow
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End With
        Application.ScreenUpdating = True
     
    '  Step 3 Add additional selection information
    Dim LastRowNo As Long
    LastRowNo = Cells(Rows.Count, "CA").End(xlUp).Row
     
    Worksheets("annovar").Range("B2").Formula = "=IFERROR(VLookup(A2,CA5:CB" & LastRowNo & ",2,0),"""")"
    Worksheets("annovar").Range("C2").Formula = "=IFERROR(VLookup(A2,CA5:CC" & LastRowNo & ",3,0),"""")"
    Worksheets("annovar").Range("D2").Formula = "=IFERROR(VLookup(A2,CA5:CD" & LastRowNo & ",4,0),"""")"
    Worksheets("annovar").Range("E2").Formula = "=IFERROR(VLookup(A2,CA5:CE" & LastRowNo & ",5,0),"""")"
    Worksheets("annovar").Range("F2").Formula = "=IFERROR(VLookup(A2,CA5:CF" & LastRowNo & ",6,0),"""")"
     
      
    '  Step 4 Add Inheritance
    Set wsLookUp = Sheets("panel")
     With Sheets("annovar")
       For Each rngCell In .Range("B5", .Range("B" & Rows.Count).End(xlUp))
         If WorksheetFunction.CountIf(wsLookUp.Range("G:G"), rngCell.Value) > 0 Then
          rngCell.Offset(0, 1).Value = WorksheetFunction.VLookup(rngCell.Value, wsLookUp.Range("G:H"), 2, 0)
         Else
          rngCell.Offset(0, 1).Value = "Item not found"
         End If
      Next rngCell
    End With
    Set wsLookUp = Nothing
     
    End Sub
    Worksheet_change VB:
     Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
        Call Calculations
    End If
    End Sub
    Calculations VB:
     Sub Calculations()
     
     '  Step 5 Add Panel Calculations
    Dim iHomopolymer As Long
    Dim iSplice As Long
    Dim iPseudogene As Long
     
    Select Case IfError(VLookup("A2", "CA5:CF74", 6, 0), "")
        Case Is = "Comprehensive Epilepsy"
            iHomopolymer = Application.Evaluate("=IF(COUNTIFS(B$2:B$6713,Q5,C$2:C$6713,""<="" & R5,D$2:D$6713, "">="" & R5),VLOOKUP(R5,$C$2:$E$6713,3,1), ""No"")")
            iSplice = Application.Evaluate("=IF(V5, ""intronic"", (COUNTIFS(B$6715:B$7731,Q5,E$6715:E$7731, ""<="" & R5,F$6715:F$7731, "">="" & R5) > 0")
            iPsuedogene = Application.Evaluate("=IF(COUNTIFS(B$7733:B$25608,Q5,C$7733:C$25608,""<="" & R5,D$7733:D$25608, "">="" & R5),VLOOKUP(R5,$C$7733:$E$25608,3,1), ""No"")")
    End Select
     
    End Sub

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,082
    Location
    Worksheet event code goes in that worksheet's code module, not in a standard code module.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

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