Page 1 of 2 1 2 LastLast
Results 1 to 10 of 16

Thread: Extract Range of Non empty cells of first row

  1. #1

    Extract Range of Non empty cells of first row



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,294
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    Try this:

    Code:
            .Application.Union(.Sheets(sSheet).Rows("5:5").SpecialCells(xlCellTypeFormulas), _
            .Sheets(sSheet).Rows("5:5").SpecialCells(xlCellTypeConstants)).Select
    Ken Puls, FCPA, FCMA, MS MVP

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  3. #3
    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

  4. #4
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,294
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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?
    Attached Files Attached Files
    Ken Puls, FCPA, FCMA, MS MVP

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  5. #5
    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

  6. #6
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,294
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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 by Ken Puls; 2011-10-12 at 07:52 AM. Reason: Updated to row 1 per Op's example
    Ken Puls, FCPA, FCMA, MS MVP

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  7. #7
    Thanks a lot for showing interest and providing guidance

    I have tried your code but an error occur

    1004: no cells found

  8. #8
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,294
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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.
    Ken Puls, FCPA, FCMA, MS MVP

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  9. #9
    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!")
    Attached Files Attached Files

  10. #10
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,294
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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
    Ken Puls, FCPA, FCMA, MS MVP

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

Page 1 of 2 1 2 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •