New sheet with select values VBA

C

cmccabe

Active Member
Joined
Feb 20, 2008
Messages
396
Hello,
I am using the multi-step code below and am having trouble on the last few steps. Currently, the [FONT=inherit !important][FONT=inherit !important]VBA[/FONT][/FONT] will classify, highlight according to the classification, and create 2 new sheets based off of a [FONT=inherit !important][FONT=inherit !important]value[/FONT][/FONT]. Is there a way to copy and paste specific highlighted rows from the main sheet (annovar), to one off the two newly created sheets? The two new sheets are depended on the value in A2 and get text Known or Unknown put after them. Thank you very much.

[FONT=inherit !important][FONT=inherit !important]The [/FONT][FONT=inherit !important]code[/FONT][/FONT] below runs up until the last step, in an attempt to accomplish the copy and paste (transfer classification) step there is a code, but it doesn't seem to work. Since the new sheets are dependent on the value in A2 I am not sure how to code that. I need some expert help. Thanks
smile.gif
.

Copy and paste from annovar to TestName Known:
Dark Red ‘9
Magenta ‘7
Blue ‘5
Cyan ‘8

Copy and paste to TestName Unknown:
Yellow ‘6
Pink ‘22
Purple ‘21

Above is the general and a specific example would be:
In the attached [FONT=inherit !important][FONT=inherit !important]workbook[/FONT][/FONT] row 4 in annovar is dark red, so the entire row would be copied to TestName Known.
In the attached workbook row 5 in annovar is yellow, so the entire row would be copied to TestName Unknown.

Code: 
[/COLOR]Option Explicit
Private Sub CommandButton1_Click()
    Dim iGender As Long
    Dim iName As Long
    Dim iInheritance As Long
    Dim iPopFreqMax As Long
    Dim iClinvar As Long
    Dim iCommon As Long
    Dim iClassification As Long
    Dim rData As Range
    Dim iRow As Long
    Dim sheet_name_to_create As String
    Dim rep As Integer
    Dim B2 As Integer
    Dim i As Long
    
     'set the range
    Set rData = Worksheets("annovar").Cells(1, 1).CurrentRegion
     
     'search row 1 and define criteria
    With Application.WorksheetFunction
        iName = .Match("Name", rData.Rows(1), 0)
        iGender = .Match("Gender", rData.Rows(1), 0)
        iInheritance = .Match("Inheritance", rData.Rows(3), 0)
        iPopFreqMax = .Match("PopFreqMax", rData.Rows(3), 0)
        iClinvar = .Match("ClinVar", rData.Rows(3), 0)
        iCommon = .Match("Common", rData.Rows(3), 0)
        iClassification = .Match("Classification", rData.Rows(3), 0)
    End With
   
      'ClinVar Step 1
    For iRow = 2 To rData.Rows.Count
        With rData.Rows(iRow)
            If .Cells(iClinvar).Value = "benign" Then .Cells(iClassification).Value = "benign"
            If .Cells(iClinvar).Value = "probable-non-pathogenic" Then .Cells(iClassification).Value = "likely benign"
            If .Cells(iClinvar).Value = "unknown" Then .Cells(iClassification).Value = "uncertain significance"
            If .Cells(iClinvar).Value = "untested" Then .Cells(iClassification).Value = "not provided"
            If .Cells(iClinvar).Value = "probable-pathogenic" Then .Cells(iClassification).Value = "likely pathogenic"
            If .Cells(iClinvar).Value = "pathogenic" Then .Cells(iClassification).Value = "pathogenic"
             
            If .Cells(iClassification).Value = "benign" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 5 'Blue
            If .Cells(iClassification).Value = "likely benign" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 8 'Cyan
            If .Cells(iClassification).Value = "uncertain significance" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 6 'Yellow
            If .Cells(iClassification).Value = "not provided" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 21 'Purple
            If .Cells(iClassification).Value = "likely pathogenic" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 7 'Magenta
            If .Cells(iClassification).Value = "pathogenic" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 9 'Dark Red
        End With
    Next iRow
       
       'AD or AR Inheritance Step 3
    For iRow = 2 To rData.Rows.Count
        With rData.Rows(iRow)
            If .Cells(iInheritance).Value = "autosomal dominant" And .Cells(iPopFreqMax).Value <= 0.01 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely pathogenic"
            If .Cells(iInheritance).Value = "autosomal dominant" And .Cells(iPopFreqMax).Value >= 0.01 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely benign"
            If .Cells(iInheritance).Value = "autosomal recessive" And .Cells(iPopFreqMax).Value <= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely pathogenic"
            If .Cells(iInheritance).Value = "autosomal recessive" And .Cells(iPopFreqMax).Value >= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely benign"
            
            If .Cells(iClassification).Value = "likely pathogenic" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 7 'Magenta
            If .Cells(iClassification).Value = "likely benign" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 8 'Cyan
            
        End With
    Next iRow
    
    'Common Step 3
    For iRow = 2 To rData.Rows.Count
        With rData.Rows(iRow)
            If .Cells(iInheritance).Value = "autosomal dominant" And .Cells(iPopFreqMax).Value <= 0.01 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "common" Then .Cells(iClassification).Value = "???"
            If .Cells(iInheritance).Value = "autosomal recessive" And .Cells(iPopFreqMax).Value <= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "common" Then .Cells(iClassification).Value = "???"
            
            If .Cells(iClassification).Value = "???" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 22 'Pink
        End With
    Next iRow
       
    'Gender Step 4
    For iRow = 2 To rData.Rows.Count
            With rData.Rows(iRow)
            If Cells(iGender, 2).Value = "Male" And .Cells(iInheritance).Value = "x-linked dominant" And .Cells(iPopFreqMax).Value <= 0.01 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely pathogenic"
            If Cells(iGender, 2).Value = "Male" And .Cells(iInheritance).Value = "x-linked reessive" And .Cells(iPopFreqMax).Value <= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely pathogenic"
            If Cells(iGender, 2).Value = "Male" And .Cells(iInheritance).Value = "x-linked dominant" And .Cells(iPopFreqMax).Value >= 0.01 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely benign"
            If Cells(iGender, 2).Value = "Male" And .Cells(iInheritance).Value = "x-linked recessive" And .Cells(iPopFreqMax).Value >= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely benign"
            If Cells(iGender, 2).Value = "Male" And .Cells(iInheritance).Value = "x-linked dominant" And .Cells(iPopFreqMax).Value <= 0.01 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "common" Then .Cells(iClassification).Value = "???"
            If Cells(iGender, 2).Value = "Male" And .Cells(iInheritance).Value = "x-linked recessive" And .Cells(iPopFreqMax).Value <= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "common" Then .Cells(iClassification).Value = "???"
             
            
            If Cells(iGender, 2).Value = "Female" And .Cells(iInheritance).Value = "x-linked recessive" And .Cells(iPopFreqMax).Value <= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely pathogenic"
            If Cells(iGender, 2).Value = "Female" And .Cells(iInheritance).Value = "x-linked recessive" And .Cells(iPopFreqMax).Value >= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "" Then .Cells(iClassification).Value = "likely benign"
            If Cells(iGender, 2).Value = "Female" And .Cells(iInheritance).Value = "x-linked recessive" And .Cells(iPopFreqMax).Value <= 0.1 And .Cells(iClinvar).Value = "" And .Cells(iCommon).Value = "common" Then .Cells(iClassification).Value = "???"
            
            If .Cells(iClassification).Value = "likely pathogenic" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 7 'Magenta
            If .Cells(iClassification).Value = "likely benign" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 8 'Cyan
            If .Cells(iClassification).Value = "???" Then .Cells(iClassification).EntireRow.Interior.ColorIndex = 22 'Pink


        End With
    Next iRow
    
    'create new workbooks based on name
sheet_name_to_create = Sheet1.Range("A2").Value & " Known"
                GoSub AddSheet
sheet_name_to_create = Sheet1.Range("A2").Value & " Unknown"
                GoSub AddSheet
                Exit Sub
AddSheet:
            For rep = 1 To (Worksheets.Count)
      If LCase(Sheets(rep).Name) = LCase(sheet_name_to_create) Then
            MsgBox "This sheet already exists!": GoTo GotIt: End If
            
   Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = _
   sheet_name_to_create
GotIt: Return


Next
       'transfer classifications
   For i = 4 To Range("A" & Rows.Count).End(3)(1).Row
    If Cells(i, "A").Interior.ColorIndex = 9 Then
        Rows(i).Copy Sheets("TestName Known").Range("A" & Rows.Count).End(3)(2)
    End If
    If Cells(i, "A").Interior.ColorIndex = 6 Then
        Rows(i).Copy Sheets("TestName Unknown").Range("A" & Rows.Count).End(3)(2)
    End If
Next i
For i = 4 To Range("A" & Rows.Count).End(3)(1).Row
    If Cells(i, "A").Interior.ColorIndex = 7 Then
        Rows(i).Copy Sheets("TestName Known").Range("A" & Rows.Count).End(3)(2)
    End If
    If Cells(i, "A").Interior.ColorIndex = 22 Then
        Rows(i).Copy Sheets("TestName Unknown").Range("A" & Rows.Count).End(3)(2)
    End If
Next i
For i = 4 To Range("A" & Rows.Count).End(3)(1).Row
    If Cells(i, "A").Interior.ColorIndex = 5 Then
        Rows(i).Copy Sheets("TestName Known").Range("A" & Rows.Count).End(3)(2)
    End If
    If Cells(i, "A").Interior.ColorIndex = 22 Then
        Rows(i).Copy Sheets("TestName Unknown").Range("A" & Rows.Count).End(3)(2)
    End If
Next i
For i = 4 To Range("A" & Rows.Count).End(3)(1).Row
    If Cells(i, "A").Interior.ColorIndex = 8 Then
        Rows(i).Copy Sheets("TestName Known").Range("A" & Rows.Count).End(3)(2)
    End If
  Next i


End Sub
[COLOR=#333333]
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
Sorry here it is:
https://onedrive.live.com/redir?resid=5D59E448AFE6FFD!143&authkey=!AOzAUsyozcf3svw&ithint=file,.xlsm

The " Transfer Classifications step is not working. It is supposed to transfer the appropriate highlighted row in annovar (master template), to a newly created sheet which depends on the value in A2. So if the value in A2 was Frank Smith a new sheet called Frank Smith Known and another sheet Frank Smith Unknown would be created. Then the highlighted row in annovar would be copied to it. If the value in A2 was Bill Walker then a new sheet Bill Walker Known and anothe Bill Walker Unknown would be created. Then the highlighted row in annovar would be copied to it. Thank you for your help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Finding Duplicate values from multiple sheets, then creating a new sheet and with all the duplicates and what sheets are the duplicates in?
Replies
1
Views
433
mumps
mumps
T
  • Question
Go To Cells That Dont Match From Table
Replies
1
Views
445
TycExcel
T
V
  • Question
How to take values in each cell in a column and use them to filter in another sheet
Replies
1
Views
322
DanteAmor
DanteAmor
J
  • Question
VBA copy selected sheets in a new workbook as values
Replies
1
Views
785
DrSimon
D
S
  • Question
Find all and get offset value in new sheet(code error)
Replies
1
Views
638
mart37
M

Forum statistics

Threads
1,214,932
Messages
6,122,332
Members
449,077
Latest member
jmsotelo

Share this page

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
Back
Top