Trying To Set Excel Font Size

[DMT Dave]

Hi Guy's, I wonder if you guy's can help with this one, I am just having an issue trying to read the last row used on the Excel sheet



The target is that if any values are less than 2 chars long within all cells used then we can use larger text

if chars longer than 2, reduce text sizes within cells used.

Just having an issue trying to read all data used on the Excel sheet for some reason (xlLR) last row used!!!

Dim varOpt As VariantDim strPath As String, strFile As String
Dim apXL As Object, xlWB As Object
Dim xlLR As Long
Dim xlCell As Range


strPath = "T:\DMT Ltd\XL Files\"


varOpt = Me.optAdd21


Select Case varOpt
    
Case Is = False


    Exit Sub
    
Case Else


Select Case Me.txt1


    Case Is = False
        
    MsgBox ("There Is Nothing In The Boxes For Your Labels"), vbInformation + vbOKOnly, "NO DATA"
    Exit Sub
    
    Case Else
    
            strFile = "Label 21.xlsx"
        
            Set apXL = CreateObject("Excel.Application")
            Set xlWB = apXL.Workbooks.Open(strPath & strFile)
            apXL.Visible = False
            'Left Down Right Accross
                With xlWB
                
                xlLR = .Worksheets(1).Range("B" & .Worksheet(1).Rows.Count).End(xlUp).Row' DONT THINK I HAVE THIS CORRECT BUT ASSUMED THIS WAS THE METHOD!!!
                
                    .Worksheets(1).Cells(3, 2) = Me.txt1
                    .Worksheets(1).Cells(3, 4) = Me.txt2
                    .Worksheets(1).Cells(3, 6) = Me.txt3
                    .Worksheets(1).Cells(6, 2) = Me.txt4
                    .Worksheets(1).Cells(6, 4) = Me.txt5
                    .Worksheets(1).Cells(6, 6) = Me.txt6
                    .Worksheets(1).Cells(9, 2) = Me.txt7
                    .Worksheets(1).Cells(9, 4) = Me.txt8
                    .Worksheets(1).Cells(9, 6) = Me.txt9
                    .Worksheets(1).Cells(12, 2) = Me.txt10
                    .Worksheets(1).Cells(12, 4) = Me.txt11
                    .Worksheets(1).Cells(12, 6) = Me.txt12
                    .Worksheets(1).Cells(15, 2) = Me.txt13
                    .Worksheets(1).Cells(15, 4) = Me.txt14
                    .Worksheets(1).Cells(15, 6) = Me.txt15
                    .Worksheets(1).Cells(18, 2) = Me.txt16
                    .Worksheets(1).Cells(18, 4) = Me.txt17
                    .Worksheets(1).Cells(18, 6) = Me.txt18
                    .Worksheets(1).Cells(21, 2) = Me.txt19
                    .Worksheets(1).Cells(21, 4) = Me.txt20
                    .Worksheets(1).Cells(21, 6) = Me.txt21
            
                For Each xlCell In Range("B3:F" & xlLR).Value
                
                    With xlCell
        
                        If Len(.text) < 2 Or Val(.Value) < 2 Then
                            .Font.Name = "Arial"
                            .Font.Size = 36
                        Else
                            .Font.Name = "Calibri"
                            .Font.Size = 16
                        End If
                    End With
                Next
                
                .Save
                End With
                
                xlWB.Close
                apXL.Quit
                Set apXL = Nothing
        
           
End Select
End Select

[Welshgasman]

I now use this, that I created instead of trying to remember the syntax all the time.
Have you walked through your code?

Function GetLastRow(pstrSheet As String, Optional pstrColumn As String) As Integer
' Return last use row for sheet and column passed in
Dim iLastRow As Integer
Dim sht As Worksheet


Set sht = Sheets(pstrSheet)
If IsNull(pstrColumn) Then pstrColumn = "A"


iLastRow = sht.Cells(ActiveSheet.Rows.Count, pstrColumn).End(xlUp).Row
GetLastRow = iLastRow
Set sht = Nothing


End Function

Change integer to Long if you have stupidly large sheets.

[DMT Dave]

Thanks WGM, I will create in a Functions,

No it's not large sheets so i should get away with whole number of integer.

Thanks Again