Extract Range of Non empty cells of first row

mubi_masti

New member
Joined
Oct 8, 2011
Messages
14
Reaction score
0
Points
0
I am using following code to format the excel sheet from access.

With xlApp
.Application.Sheets(sSheet).Select
.Application.Cells.Select
.Application.Selection.ClearFormats
.Application.Rows("1:1").Select


in first row only five cells have values and instead of selecting whole row i want to apply formatting on only those cells that have values. For this i need to give range to following method. Is it possible excel autometically identify the range and apply formatting.

.Application.Rows("1:1").Select

like following

.Application.Rows("a1:a5").Select
progress.gif
 
Try this:

Code:
        .Application.Union(.Sheets(sSheet).Rows("5:5").SpecialCells(xlCellTypeFormulas), _
        .Sheets(sSheet).Rows("5:5").SpecialCells(xlCellTypeConstants)).Select
 
thanks for suggesting this solution

i have tried your code but following error occur

"1004-unable to get the specialcell property of the range class"

i have no idea about your code and what is the solution
 
Here's the full routine I used to test it:
Code:
    Dim xlApp As Application
    Dim sSheet As String
    
    Set xlApp = Application
    sSheet = "Sheet1"
    
    With xlApp
        .Application.Union(.Sheets(sSheet).Rows("5:5").SpecialCells(xlCellTypeFormulas), _
        .Sheets(sSheet).Rows("5:5").SpecialCells(xlCellTypeConstants)).Select
    End With

A copy of the workbook is attached to show it working as well.

If you still can't get it to go, is there any way you can upload a sample workbook demonstrating the problem?
 

Attachments

  • xlgf475-1.xls
    42 KB · Views: 35
Thanks a lot,

your provided code works best when it is executed from excel. I have change the location of data along with range in the macro, it works fine but same code i copied in VB of access, as i want to export data from access to excel, the same error appears.


your support really encourage me to ask few more question.

Along with same problem, i want to change the color and border of heading row, the zoom and page break preview.

which method can be called to execute above formatting.


Following is the complete code which is used and call from one of the form of access.


Code:
Public Sub ModifyExportedExcelFileFormats(sFile As String, sSheet As String)
On Error GoTo Err_ModifyExportedExcelFileFormats
Application.SetOption "Show Status Bar", True
vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting export file... please wait.")
Dim xlApp As Object
Dim xlSheet As Object
Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)
With xlApp
.Application.Sheets(sSheet).Select
.Application.Cells.Select
.Application.Selection.ClearFormats
.Application.Union(.Sheets(sSheet).Rows("1:1").SpecialCells(xlCellTypeFormulas), _
        .Sheets(sSheet).Rows("1:1").SpecialCells(xlCellTypeConstants)).Select
.Application.Selection.Font.Bold = True
.Application.Selection.Font.Name = "arial"
.Application.Selection.HorizontalAlignment = -4108
.Application.Cells.Select
.Application.Selection.RowHeight = 14
.Application.Selection.Font.Name = "Arial"
.Application.Selection.Font.Size = 11
.Application.Selection.Columns.AutoFit
.Application.Selection.VerticalAlignment = -4108
.Application.Range("A2").Select
.Application.ActiveWindow.FreezePanes = True
.Application.Columns("A").Select
.Application.Selection.NumberFormat = "dd-mmm-yy"

    

.Application.Activeworkbook.Save
.Application.Activeworkbook.Close
.Quit
End With
Set xlApp = Nothing
Set xlSheet = Nothing
vStatusBar = SysCmd(acSysCmdClearStatus)
Exit_ModifyExportedExcelFileFormats:
Exit Sub
Err_ModifyExportedExcelFileFormats:
vStatusBar = SysCmd(acSysCmdClearStatus)
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ModifyExportedExcelFileFormats
End Sub
 
Ah, I didn't realize that you were calling it from Access. In that case we can't use the constants names, we need to use their numbers. Try changing the Union line to:

Code:
.Union(.Sheets(sSheet).Rows("1:1").SpecialCells(2), _
        .Sheets(sSheet).Rows("1:1").SpecialCells(-4123)).Select

Also, FYI, you don't need the .Application at the beginning of all those lines. You've already set xlApp as the application, so you're effectively saying Application.application every time. :)
 
Last edited:
Thanks a lot for showing interest and providing guidance

I have tried your code but an error occur

1004: no cells found
 
Are yo usure that there are cells in the address that you're specifying? That error would indicate that there aren't.

Try this routine. I have not tested this from Access, but I've siginficantly cleaned up your code to optimize it, commented it to display what it's all doing, and added error handling to deal with blank areas. Be aware that this version is looking in row 1 for data. If you data will be elsewhere, you'll need to change that.

Code:
Public Sub ModifyExportedExcelFileFormats(sFile As String, sSheet As String)
    Dim xlApp As Object
    Dim xlSheet As Object
    Dim vStatusBar
    Dim lErrNumber As Long
    Dim xlRange As Object
    'Set up error handling for routine
    On Error GoTo Err_ModifyExportedExcelFileFormats
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting export file... please wait.")
    'Create Excel objects using late binding
    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(sSheet)
    'This line for debugging.  Comment if you don't want to see it any more
    xlApp.Visible = True
    'Clear formats from exisiting worksheet
    xlSheet.Cells.ClearFormats
    
    'Select data
    With xlApp
        On Error Resume Next
        Set xlRange = .Union(.Sheets(sSheet).Rows("1:1").SpecialCells(2), _
                             .Sheets(sSheet).Rows("1:1").SpecialCells(-4123)).Select
        lErrNumber = Err.Number
    End With
    On Error GoTo Err_ModifyExportedExcelFileFormats
    'Check if any cells found
    If lErrNumber <> 0 Then
        'No cells found
        MsgBox ("Sorry, no cells match the criteria!")
    Else
        'Cell found.  Format cells with data
        With xlRange
            .Font.Bold = True
            .Font.Name = "arial"
            .HorizontalAlignment = -4108
        End With
        'Reformat worksheet
        With xlSheet.Cells
            .RowHeight = 14
            .Font.Name = "Arial"
            .Font.Size = 11
            .Columns.AutoFit
            .VerticalAlignment = -4108
            .Columns("A").NumberFormat = "dd-mmm-yy"
            .Range("A2").Select
            .ActiveWindow.FreezePanes = True
        End With
    End If
    'Save workbook and close
    With xlApp
        .ActiveWorkbook.Save
        .ActiveWorkbook.Close
        .Quit
    End With
    'Release variables
    Set xlRange = Nothing
    Set xlSheet = Nothing
    Set xlApp = Nothing
    vStatusBar = SysCmd(acSysCmdClearStatus)
    'Normal exit point for subroutine
Exit_ModifyExportedExcelFileFormats:
    Exit Sub
Err_ModifyExportedExcelFileFormats:
    'Report on unexpected errors
    vStatusBar = SysCmd(acSysCmdClearStatus)
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_ModifyExportedExcelFileFormats
End Sub

FYI, I've also added a line in there that shows the Excel application so that this is easier to debug. Once you have it all working, you can just place a comment (') in front of the line and it will be ignored at runtime.
 
Thanks Ken for time you are spending for imporving my code, you support is very encouraging

i have replaced my code with your code but following message appear. The code is not applying any formatting. I am sending you file which i m exporting from access and i want to format that file.

MsgBox ("Sorry, no cells match the criteria!")
 

Attachments

  • Oct 12 2011 Session.xls
    19.5 KB · Views: 16
Ah, sorry. I didn't realize that you were working with a text header only. The routine was choking because it was also looking for formulas. Try this:

Code:
Public Sub ModifyExportedExcelFileFormats(sFile As String, sSheet As String)
    Dim xlApp As Object
    Dim xlSheet As Object
    Dim vStatusBar
    Dim lErrNumber As Long
    Dim xlRange As Object
    'Set up error handling for routine
    On Error GoTo Err_ModifyExportedExcelFileFormats
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting export file... please wait.")
    'Create Excel objects using late binding
    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(sSheet)
    'This line for debugging.  Comment if you don't want to see it any more
    xlApp.Visible = True
    'Clear formats from exisiting worksheet
    xlSheet.Cells.ClearFormats
    'Select data
    With xlSheet
        On Error Resume Next
        Set xlRange = .Rows("1:1").SpecialCells(2)
        lErrNumber = Err.Number
    End With
    On Error GoTo Err_ModifyExportedExcelFileFormats
    'Check if any cells found
    If lErrNumber <> 0 Then
        'No cells found
        MsgBox ("Sorry, no cells match the criteria!")
    Else
        'Cell found.  Format cells with data
        With xlRange
            .Font.Bold = True
            .Font.Name = "arial"
            .HorizontalAlignment = -4108
        End With
        'Reformat worksheet
        With xlSheet.Cells
            .RowHeight = 14
            .Font.Name = "Arial"
            .Font.Size = 11
            .Columns.AutoFit
            .VerticalAlignment = -4108
            .Columns("A").NumberFormat = "dd-mmm-yy"
            .Range("A2").Select
        End With
        xlSheet.ActiveWindow.FreezePanes = True
    End If
    'Save workbook and close
    With xlApp
        .ActiveWorkbook.Save
        .ActiveWorkbook.Close
        .Quit
    End With
    'Release variables
    Set xlRange = Nothing
    Set xlSheet = Nothing
    Set xlApp = Nothing
    vStatusBar = SysCmd(acSysCmdClearStatus)
    'Normal exit point for subroutine
Exit_ModifyExportedExcelFileFormats:
    Exit Sub
Err_ModifyExportedExcelFileFormats:
    'Report on unexpected errors
    vStatusBar = SysCmd(acSysCmdClearStatus)
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_ModifyExportedExcelFileFormats
End Sub
 
thanks once again

but i am stuck with this code, there is again error

438: object does not support this property or method

program export file successfully, apply formatting but does not close the file and give error mentioned above

Ken, you are giving too much support and help, for all your efforts thanks once again.

can you help in other problem as well.

previously you have provided an excel file which select a selected range, can you develop macro which define the name of that range and copy the range reference in B2 cell


for example , name range as "tblheadings" and copy reference in B2 as: Sheet!$A$1:$A$5
 
I have rectify the error of exported excel file. thanks a lot

can you provide the solution of other two problems mention in the last message about naming and pasting the range.

How can i use following methods for setting the border and shadding

.Application.Selection.Borders (7)
.LineStyle = 1
.Weight = 2
.Application.Selection.Borders (8)
.LineStyle = 1
.Weight = 2
.Application.Selection.Borders (9)
.LineStyle = 1
.Weight = 2
.Application.Selection.Borders (10)
.LineStyle = 1
.Weight = 2
.Application.Selection.Borders (11)
.LineStyle = 1
.Weight = 2
.Application.Selection.Borders (12)
.LineStyle = 1
.Weight = 2
 
Done it!!!!!!!!!!!!

at last i m able to format my excel sheet according to my own requirement

it is only possible with your help


Great!!!!!!!!!!!!!!!!!!:clap2:

now i am expecting only one favor and i.e defined the range and copy in excel. This task is required while working in excel.
 
Dear Ken

You have provided the attached excel file in which by pressing the button the cells contains data are selected.

I want to do two tasks:
first: define the name of selected range as "data_selected"
second: copy the range (=Sheet1!$B$5:$H$5) in a cell (let B2 = Sheet1!$B$5:$H$5)
 

Attachments

  • xlgf475-1.xls
    42 KB · Views: 12
To name the range, add a line to the routine as follows:

Code:
Sub test()
    Dim xlApp As Application
    Dim sSheet As String
    
    Set xlApp = Application
    sSheet = "Sheet1"
    
    With xlApp
        .Application.Union(.Sheets(sSheet).Rows("5:5").SpecialCells(xlCellTypeFormulas), _
        .Sheets(sSheet).Rows("5:5").SpecialCells(xlCellTypeConstants)).Select
        .ActiveWorkbook.Names.Add Name:="data_selected", RefersTo:=Selection
    End With
End Sub

Not sure what you mean on the second part... If you're just using numbers in your data, you could just type in =SUM(data_selected)...
 
Back
Top