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
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,111
Office Version
  1. 365
Platform
  1. Windows
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
 

cmccabe

Active Member
Joined
Feb 20, 2008
Messages
396
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
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,111
Office Version
  1. 365
Platform
  1. Windows
What do you mean by not working? Are you confusing rows with columns?
 

cmccabe

Active Member
Joined
Feb 20, 2008
Messages
396

ADVERTISEMENT

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.
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,111
Office Version
  1. 365
Platform
  1. Windows
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?
 

cmccabe

Active Member
Joined
Feb 20, 2008
Messages
396

ADVERTISEMENT

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.
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,111
Office Version
  1. 365
Platform
  1. Windows
Maybe this?

Code:
Rows("1:1").WrapText = True
 

Watch MrExcel Video

Forum statistics

Threads
1,109,425
Messages
5,528,688
Members
409,830
Latest member
KT50

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top