resize cells in VBA

cmccabe

Active Member
Joined
Feb 20, 2008
Messages
396
I am trying to resize cells on a specific page (Low Coverage). Thank you.

Code:
 sh3.Range("A:J").Select
   Selection.Columns.AutoFit
this code gives a select method of Range class error

Code:
 Columns("A:J").Select
   Selection.Columns.AutoFit
seems to resize the only thecells on the page where the button is (Template)

Entire 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
 

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.
You will have to select sh3 first then select the range on next line if you want to select.

or:

Code:
sh3.Range("A:J").Columns.AutoFit
 
Upvote 0
Basically I am trying to resize row 1 on the Low Coverage sheet. I have underlined the line of code that is not working and here is a link to the workbook. Thanks.

https://app.box.com/s/8q8toywflp975osx8640

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
    
[U]   sh3.Range("A1:J1").Rows.AutoFit[/U]
    
        .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
 
Upvote 0
What do you mean by not working? Are you confusing rows with columns?
 
Upvote 0
On the Low Coverage sheet row 1 is not resized to the text. On the link if you say no to the prompt and then click the button the Low Coverage sheet will populate after 10 seconds. Thanks.
 
Upvote 0
Hi. I have the book and if i press Compare Amplicons button it populates Low Coverage sheet immediately and row 1 is autofit? Are you getting a runtime error?
 
Upvote 0
No runtime error.... it is just row 1 columns H-J (
Sporatic RegionsLow Coverage RegionsNew Regions

<tbody>
</tbody>
do not appear to be resized to the text. Thanks.
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,177
Members
448,554
Latest member
Gleisner2

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