Help with blank excel script

Author Message
niel.horak

  • Total Posts : 3
  • Scores: 0
  • Reward points : 0
  • Joined: 10/24/2011
  • Status: offline
Help with blank excel script Monday, October 24, 2011 11:46 AM (permalink)
0
Hi all.
 
I got this script that creates fix length cells in excel and then export to TXT. My issue is it does not export the blank cells. Can someone help with the script? So what need to happen is that if the cell is blank it must still export the cell with selected length (characters).
End result should be something like... "      1234    1234    1234  3456 123 45675                " Please see script below.
 
Thanks,
Niel
 
********************
Sub Export_Selection_As_Fixed_Length_File()
     ' Dimension all  variables.
    Dim DestinationFile, CellValue, Filler_Char_To_Replace_Blanks As String
    Dim FileNum, ColumnCount, RowCount, FieldWidth As Integer
    Dim sht As Worksheet
   
    'Below are options incase you want to change the folder where VBA stores the .txt file
    'We use ActiveWorkbook.Path in this example
    'ActiveWorkbook.Path 'the activeworkbook
    'ThisWorkbook.Path  'the workbook with the code
    'CurDir  'the current directory (when you hit File|open)

    'If a cell is blank, what character should be used instead
    Filler_Char_To_Replace_Blanks = " "
    
        'Check if the user has made any selection at all
        If Selection.Cells.Count < 2 Then
            MsgBox "Nothing selected to export"
            Selection.Activate
            End
        End If
    
    'This is the destination file name.
    DestinationFile = ActiveWorkbook.Path & "/Payroll.txt"
    'Obtain next free file handle number.
    FileNum = FreeFile()
   
     ' Turn  error checking off.
    On Error Resume Next
    
     ' Attempt to open destination file for output.
    Open DestinationFile For Output As #FileNum
    
     ' If an error occurs report it and end.
    If Err <> 0 Then
         MsgBox "Cannot open filename " & DestinationFile
         Selection.Activate
        End
    End If
    
     ' Turn error checking on.
    On Error GoTo 0
    
     '  Loop for each row in selection.
    For RowCount = 1 To Selection.Rows.Count
                For ColumnCount = 1 To Selection.Columns.Count
                    CellValue = Selection.Cells(RowCount, ColumnCount).Text
                    If (IsNull(CellValue) Or CellValue = "") Then CellValue = Filler_Char_To_Replace_Blanks
                    FieldWidth = Cells(1, ColumnCount).Value
                    If (ColumnCount = Selection.Columns.Count) Then
                            Print #FileNum, Format$(CellValue, "!" & String(FieldWidth, "@")) & vbCrLf;
                    Else: Print #FileNum, Format$(CellValue, "!" & String(FieldWidth, "@"));
                    End If
                Next ColumnCount
         ' Start next iteration of RowCount loop.
    Next RowCount
     ' Close destination file.
    Close #FileNum
    Selection.Activate
    Workbooks.OpenText Filename:=DestinationFile
End Sub
 
#1

    Online Bookmarks Sharing: Share/Bookmark

    Jump to:

    Current active users

    There are 0 members and 1 guests.

    Icon Legend and Permission

    • New Messages
    • No New Messages
    • Hot Topic w/ New Messages
    • Hot Topic w/o New Messages
    • Locked w/ New Messages
    • Locked w/o New Messages
    • Read Message
    • Post New Thread
    • Reply to message
    • Post New Poll
    • Submit Vote
    • Post reward post
    • Delete my own posts
    • Delete my own threads
    • Rate post

    2000-2012 ASPPlayground.NET Forum Version 3.9