VBA to copy and calculate highlighted cells

[cmccabe]

Hello,

https://onedrive.live.com/redir?resid=5D59E448AFE6FFD!139&authkey=!ADVXbtEnxwveOnE&ithint=file,.xlsm

I am hoping that this description helps as I am stuck. Steps 1-3 [FONT=inherit !important][FONT=inherit !important]work[/FONT][/FONT] correctly it is the steps after that I am having trouble with. I have attached a link to the spreadsheet and the 4th tab has the desired output in it. Thank you very much for any help.

STEP 1: Highlight in Red amplicons in [FONT=inherit !important][FONT=inherit !important]Template[/FONT][/FONT] that do not meet criteria.
STEP 2: If the value in D2:D is “” THEN ignore (If Range("D2:D").value = "" Then)
STEP 3: Match column D2:D in Template if it is highlighted Red with column D2:D in Source.
STEP 4: If there is a match in a new sheet (Low Coverage) all the [FONT=inherit !important][FONT=inherit !important]information[/FONT][/FONT] in columns A,B,C,D,E,F,G,H,I,J from Source put in there
STEP 5: Match column D2:D in Template if it is highlighted Red with column D2:D in Source AND If in Column J in Source there is a Y then column J in Low Coverage is Pink, if in Column J in Source there is a N then column J in Low Coverage is Y Green, if in Column J in Source there is “” then column J in Low Coverage is Yellow with a ? in it
STEP 6: If the D2:D column in Template highlighted Red is not in Source then the information from columns A,B,C,D,E,H,I,J is put in Low Coverage.
STEP 7: If column J2:J in Low Coverage is Pink then add all and place the value in a new column L on Low Coverage called “Sanger Regions”. If column J2:J in Low Coverage is Yellow then sum of all the yellow and in a new column L on Low Coverage called “New Regions”.


[/CODE]
Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim l As Long
Application.ScreenUpdating = False




'Depth of Coverage code
l = Range("J" & Rows.Count).End(xlUp).Row
For Each rngCell In Range("J2:J" & l)
Select Case rngCell.Value
Case Is <= 120
rngCell.Interior.Color = RGB(255, 255, 0) 'Yellow
rngCell.Offset(0, -6).Interior.Color = RGB(255, 0, 0) 'Red
End Select
Next rngCell




l = Range("H" & Rows.Count).End(xlUp).Row
For Each rngCell In Range("H2:H" & l)
Select Case rngCell.Value + rngCell.Offset(0, 1).Value
Case Is <= 120
rngCell.Interior.Color = RGB(255, 204, 0) 'Orange
rngCell.Offset(0, 1).Interior.Color = RGB(255, 204, 0) 'Orange
rngCell.Offset(0, -4).Interior.Color = RGB(255, 0, 0) 'Red
End Select
Next rngCell
' Formula in column M
Range("M2").Formula = "=J2/SUM($J$2:$J$396)"
With Range("M2:M" & l)
.FillDown
.NumberFormat = "#.0000"
End With

Application.ScreenUpdating = True
Range("M1").Value = "% of Reads"


Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
' create short references to sheets
' inside the Sheets() use either the tab number or name
Set sh1 = Sheets("Source"): Set sh2 = Sheets("Template"): Set sh3 = Sheets("Low Coverage")


' Create iterators
Dim i As Long, j As Long
' Create last rows values for the columns you will be comparing
Dim lr1 As Long, lr2 As Long
' create a reference variable to the next available row in sheet3
Dim nxtRow As Long
' Create ranges to easily reference data
Dim rng1 As Range, rng2 As Range, rCell As Range


' Assign values to variables
lr1 = sh1.Range("D" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("D" & Rows.Count).End(xlUp).Row


' Clear sheet3
sh3.Cells.ClearContents


Application.ScreenUpdating = False
sh1.Range("A1").EntireRow.Copy Destination:=sh3.Range("A1")


For Each rCell In sh1.Range("D2:D" & lr1)
If rCell.Value <> "" Then 'ignore empty values
If rCell.Value = sh2.Range("D" & rCell.Row).Value Then 'sh1 D value = sh2 D value
rCell.Interior.ColorIndex = 3 'red
'color based on sh1 column J value
Select Case sh1.Range("J" & rCell.Row)
Case Is = "Y"
sh1.Range("J" & rCell.Row).Interior.ColorIndex = 4 'green
Case Is = "N"
sh1.Range("J" & rCell.Row).Interior.ColorIndex = 7 'pink
Case Is = ""
sh1.Range("J" & rCell.Row).Value = "?"
sh1.Range("J" & rCell.Row).Interior.ColorIndex = 6 'yellow
End Select
sh1.Range("A" & rCell.Row, "J" & rCell.Row).Copy Destination:=sh3.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'copy range to sh3
End If
End If
Next rCell


Application.ScreenUpdating = True


End Sub
[/CODE]