I am trying to resize cells on a specific page (Low Coverage). Thank you.
this code gives a select method of Range class error
seems to resize the only thecells on the page where the button is (Template)
Entire Code
VB
Code:
sh3.Range("A:J").Select
Selection.Columns.AutoFit
Code:
Columns("A:J").Select
Selection.Columns.AutoFitEntire Code
VB
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:J)"
With Range("M2:M" & l)
.FillDown
.NumberFormat = "#.00000"
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
Dim rF 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.Clear
'Application.ScreenUpdating = False
sh1.Range("A1").EntireRow.Copy Destination:=sh3.Range("A1")
With sh1
For Each rC In .Range("A1").CurrentRegion.Columns(7).Cells
If rC.Value = "Y" Then rC.Interior.ColorIndex = 7
If rC.Value = "N" Then rC.Interior.ColorIndex = 4
If rC.Value = "Yes" Or rC.Value = "No" Then
rC.Interior.ColorIndex = 8
End If
Next rC
Application.Intersect(.Range("A1").CurrentRegion, .Range("A1").CurrentRegion.Offset(1)).Columns("D").Interior.Color = vbRed
End With
With sh2
For Each rC In .Range("D2:D" & lr2).Cells
If rC.Interior.Color = vbRed Then
On Error Resume Next
Set rF = sh1.Range("D2:D" & lr1).Find(rC.Value)
If Not rF Is Nothing Then
rF.EntireRow.Copy sh3.Range("A" & Rows.Count).End(xlUp).Offset(1)
Else
rC.EntireRow.Copy sh3.Range("A" & Rows.Count).End(xlUp).Offset(1)
sh3.Range(sh3.Range("F" & Rows.Count).End(xlUp), sh3.Range("M" & Rows.Count).End(xlUp)).Delete shift:=xlToLeft
'sh3.Range(sh3.Range("I" & Rows.Count).End(xlUp), sh3.Range("K" & Rows.Count).End(xlUp)).Delete shift:=xlToLeft
sh3.Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = "?"
sh3.Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Interior.ColorIndex = 46
End If
End If
Next rC
On Error GoTo 0
End With
With sh3
Dim lRow As Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'Formula in column L
sh3.Range("A:J").Select
Selection.Columns.AutoFit
.Range("H1").Value = "Sporatic Regions"
.Range("I1").Value = "Low Coverage Regions"
.Range("J1").Value = "New Regions"
.Range("H2").Formula = "=COUNTIF(RC[-1]:R[" & lRow - 2 & "]C[-1],""Yes"")"
.Range("I2").Formula = "=COUNTIF(RC[-2]:R[" & lRow - 2 & "]C[-2],""Y"")"
.Range("J2").Formula = "=COUNTIF(RC[-3]:R[" & lRow - 2 & "]C[-3],""~?"")"
End With
Application.ScreenUpdating = True
End Sub
