+ Reply to Thread
Results 1 to 1 of 1

Macro code to pull cell info into .csv file

Hybrid View

  1. #1
    Registered User
    Join Date
    08-30-2012
    Location
    Virginia, USA
    MS-Off Ver
    Excel 2007
    Posts
    1

    Macro code to pull cell info into .csv file

    Greetings: I am a new (3weeks) user with VBA. I have been given a huge task to complete, and I am very grateful for any help people could offer. I have posted this to the moderator, but perhaps someone else is able to help me in case he already has a ton on his plate. Here is the post

    Mr. Ross,

    I just found your code (see copy below), from back in 2007. YOu helped somebody export info from their sheet into a text file. I'm trying to utilize a macro to copy certain cells into a .csv file so that can be imported inot a database. Would you be able to help me?

    My current code:

    Sub clear_archive_task()
    Dim taskrange As Range
    
    Dim cbox As CheckBox
    Dim cbrng As Range
    
    With ActiveSheet
    For Each cell In Range("I7:I14")
    If cell Then
    i = cell.Row
    Range("b" & i & ":D" & ", G" & i).Cells.Copy Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Set cbring = Range("e" & i).Cells
    For Each cbox In ActiveSheet.CheckBoxes
    If Intersect(cbox.TopLeftCell, cbrng) Is Nothing Then
    Else
    cbox.Delete
    End If
    Next cbox
    cell.EntireRow.Delete
    End If
    Next cell
    End With
    End Sub
    I would like to take the information in cells "B", "C", "D" and "G" and export it to a .csv file with the headers "B" = Task, "C" = Date assigned, "D" = Date Due "G" = Update, and a cell in the csv file that time stamps the import for "Completed" date. I was also hoping that I could pull the "name" of the sheet and drop it into a file to. I know it's a lot, and I hope it's not too much to ask. Please help if can. Thanks so much in advance.

    Your code that I am trying to modify:

    Sub CopyToTextFile(Wks As Worksheet)
    
    Const ForAppending As Long = 8
    Const AsciiFormat As Long = 0
    
    Dim C As Long
    Dim ColArray() As Long
    Dim BlankCols As Range
    Dim N As Long
    Dim R As Long
    Dim Rng As Range
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set TxtFile = fso.OpenTextFile("c:\TestFile.txt", ForAppending, DefaultFormat)
    
    With Wks.UsedRange
    StartRow = .Row
    LastRow = .Rows.Count + StartRow - 1
    StartCol = .Column
    LastCol = .Columns.Count + StartCol - 1
    On Error Resume Next
    Set BlankCols = .SpecialCells(xlCellTypeBlanks)
    If Err.Number = 1004 Then
    Err.Clear
    GoTo NoMoreBlanks
    End If
    On Error GoTo 0
    End With
    
    For Each Rng In BlankCols.Areas
    ReDim Preserve ColArray(N)
    ColArray(N) = Rng.Column
    N = N + 1
    Next Rng
    
    For N = 0 To UBound(ColArray)
    StopCol = ColArray(N) - 1
    Set Rng = Wks.Range(Cells(StartRow, StartCol), Cells(LastRow, StopCol))
    GoSub WriteDataToFile
    StartCol = ColArray(N) + 1
    Next N
    
    NoMoreBlanks:
    If Err.Number <> 0 Then GoTo Finished
    Set Rng = Wks.Range(Cells(StartRow, StartCol), Cells(LastRow, LastCol))
    GoSub WriteDataToFile
    GoTo Finished
    
    WriteDataToFile:
    For R = 1 To Rng.Rows.Count
    For C = 1 To Rng.Columns.Count
    TxtData = TxtData & Rng.Cells(R, C) & vbTab
    Next C
    TxtData = Left(TxtData, Len(TxtData) - 1)
    TxtFile.WriteLine (TxtData)
    TxtData = ""
    Next R
    Return
    
    Finished:
    TxtFile.Close
    Set fso = Nothing
    Set TxtFile = Nothing
    
    End Sub
    
    Sub SaveWorksheets()
    
    Dim Wks As Worksheet
    
    Application.ScreenUpdating = False
    
    For Each Wks In ThisWorkbook.Worksheets
    Wks.Activate
    CopyToTextFile Wks
    Next Wks
    
    Application.ScreenUpdating = True
    
    End Sub
    Attached Files Attached Files
    Last edited by newbie10; 08-31-2012 at 05:00 AM. Reason: Please see the forum rules about proper code tags also

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1