VBA Excel RowHeight (Diff-Range)

[imfarhan]

Hi All,
I have got MS Query written by 7 sheets of Excel (Sun to Sat)
each day have got different values comes ..some time 2 rows some time 6rows

My following VBA code is working fine , only problem is the row height I restricted to 1: to 6 as you can see in the code given below:
I would like to change the row size to 53.4 ONLY where the value exist not specific rage 1:6
Problem in red fonts area given below:-

   'Check total waiters workbook is open select if available, exit if not
    'For Each wbk In wbReport
        If InStr(UCase(swb.Name), "Weekly C Floor Report.xls") <> 0 Then
            For Each wSheet In swb.Worksheets
                wks = wSheet.Name
''''''   START OF CODE
                       Sheets(wks).Select
                       ActiveSheet.PageSetup.Orientation = xlLandscape
                       With ActiveSheet.PageSetup
                           .LeftMargin = Excel.Application.InchesToPoints(0.2)
                           .RightMargin = Excel.Application.InchesToPoints(0.2)
                           .FitToPagesWide = 1
                           .FitToPagesTall = 3
                           .Zoom = 85
                           .CenterHeader = "&A"
                           Columns("C:C").ColumnWidth = 10.11
                           Columns("D:D").ColumnWidth = 20.67
                           Columns("F:F").ColumnWidth = 20.67
                           Columns("H:H").ColumnWidth = 11.78
                           'Columns("N:N").ColumnWidth = 10.78
                           Columns("G:G").ColumnWidth = 31.78
 
 
                          [COLOR=darkred] [B]Rows("1:6").Select[/B][/COLOR]
[B][COLOR=darkred]                              Selection.RowHeight = 53.4[/COLOR][/B]
                       End With

Many thanks
F

 

[boblarson]

Bob

Are you referring to the use of things like ActiveSheet, Columns etc without references?

Right,
I am talking about things like

Activesheet.Range("A1").Select

Where it should be tied to an application object ,

obXL.Activesheet.Range("A1").Select

 

[imfarhan]

Hi Bob & Norie,
sorry for late reply...
The application originally written by some one , I just maintain , i think the Ms Automation application does the followng step to run each job

Step (1)

Function CreateXLSReport(clsReport As TaskInfo) As ReturnStatus
    Dim wb As Workbook
    Dim uReturn As ReturnStatus
 
    On Error GoTo Err_Handler
    'LogUpdate "Check FS-temp-1: "
 
    uReturn = OpenXLFile(clsReport.SourceDir & clsReport.SourceFilename, wb)
 
    Select Case uReturn
        Case ReturnStatus.AllOK
            wb.Application.ScreenUpdating = False
            'Cycle through all the sheets and refresh any query tables found
            uReturn = [COLOR=darkred][B]RefreshwbQueryTables(wb)[/B][/COLOR]

Step (2)

OpenXLFile ()

 Returns a reference to the newly opened workbook via the wbReport parameter.
Function OpenXLFile(sTemplateFile As String, wbReport As Workbook) As ReturnStatus
    On Error GoTo Err_Handler
    If Dir(sTemplateFile, vbNormal) <> "" Then
        LogUpdate "Opening Template: " & sTemplateFile
        Set wbReport = Workbooks.Open(sTemplateFile, False)
        wbReport.Application.Visible = True
 
        'Reset the Excel Addins to prevent the formula from sometimes
        ' showing #Name instead of the full report date range and run date
        On Error Resume Next
        wbReport.Application.AddIns("Analysis Toolpak").Installed = False
        wbReport.Application.AddIns("Analysis Toolpak - VBA").Installed = False
        On Error GoTo Err_Handler
 
        DoEvents
        wbReport.Application.AddIns("Analysis Toolpak").Installed = True
        DoEvents
        wbReport.Application.AddIns("Analysis Toolpak - VBA").Installed = True
        DoEvents
 
        OpenXLFile = AllOK

Step (3) which is called from Step(1) CreateXLS Report

Private Function RefreshwbQueryTables(wbReport As Workbook) As ReturnStatus
Dim qt As QueryTable
Dim shtTmp As Variant
Dim SQLTmp As String

On Error GoTo Err_Handler

For Each shtTmp In wbReport.Sheets
If InStr(1, shtTmp.Name, "CHART") = 0 Then
For Each qt In shtTmp.QueryTables

' 'Let's replace any ODBC connections with an OLEDB connection for speed and reliability(?)
' qt.Connection = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentDb.Name & ";User Id=admin;Password=;"
' qt.MaintainConnection = True

'Rebuild the query table SQL to handle any field changes in the source query/table
' SQLTmp = qt.CommandText
' SQLTmp = "SELECT * " & Right(SQLTmp, Len(SQLTmp) - (InStr(1, SQLTmp, "FROM") - 1))
' qt.CommandText = SQLTmp
' Debug.Print shtTmp.Name

'Refresh the data and wait until everything has been returned
qt.Refresh BackgroundQuery:=False

Next
End If
Next

RefreshwbQueryTables = AllOK

I think thats what Automation generate report, The queries written behing the Ms Query and source of those queries are in table
But I think you're right its not an effective way to use Ms Query as it give me loads of problem already i.e. locking and some time reports failed and so on
I need to use TranferSpreadsheet function as you advised or some other good way but don't know how?
I have around 100 reports which runs daily/weekly and monthly. (I need to find out the way to call all queries using Recordset as per their frequence to run i.e. daily/weekly or monthly... don't konw how how can plus each report have different templae (which I do'nt think I need it if I chose a new route i.e. TransferData).

This is one of my aim for this year.... to completely take off the Ms Query route..... and the new steps in mind are as follows:-
step1 - Create Queries for those reports due to run
step2 - Keep the results using Recordset
step 3 - The output will be in new excel sheet
Step4 - Save the output in new location with datetime stamp.

Please correct me and give me your assitance

Many thanks and Regards
Farhan