Friday, September 09, 2011

Excel VBA failed to disappoint

At work I have some stuff I always copy from text file to MS Excel. Being infinitely lazy, I tried using Clojure to carry out this routine task. However, I found Clojure a bit an issue here because it means having Clojure and Java runtime everywhere. And I wanted something that is pretty simple and easy to use. This left me with one option, Macro. I lacked motivation but I was challenged when I saw someone who had not really programmed before using Macros. This is what led me to VBA ... I still think I have not reached the beginner's level yet, however I was able to achieve something, I got my task automated.
Sub Button2_Click()
    'File Chooser
     sFilename = Application.GetOpenFilename("Excel files (*.txt*),*.txt*", 1, "Custom Dialog Title", False)
    Dim oFSO As New FileSystemObject
    Dim oFS
    Dim num As Integer
    Dim mynum As Integer
    Dim strStrings As Variant
    Dim intInd As Integer
    Dim MyString As String
    Dim CheckRow As Integer

   'This one reads file

    Set oFS = oFSO.OpenTextFile(sFilename)
    num = 15
    mynum = 1
    CheckRow = 0
    Do Until oFS.AtEndOfStream
        'Cells(num, mynum).Value = oFS.ReadLine
         MyString = oFS.ReadLine
         Do While InStr(MyString, "  ") 'Find 
         MyString = Replace(MyString, "  ", " ") 'Clean up compress the free space
         'Array of strings
         strStrings = Split(MyString, " ")
         If UBound(strStrings) > 0 And UBound(strStrings) <= 5 Then
         'For loop ... like in other languages(modern languages)
         For intInd = LBound(strStrings) To UBound(strStrings)
             If Not strStrings(intInd) = "=>" And Not strStrings(intInd) = " " And IsNumeric(strStrings(intInd)) Then
             If CheckRow > 4 Then
                        MsgBox ("There is something wrong, you have more data than needed. Please edit")
                      Exit Do
             End If
             If mynum < 8 Then
             Cells(num, mynum).Value = strStrings(intInd)
             'Filling excel cells
             mynum = mynum + 1
                 mynum = 1
                 num = num + 1
                 CheckRow = CheckRow + 1
             End If

             End If
        End If
    If CheckRow < 4 Then
      MsgBox ("There is something wrong, you have fewer data. Finding out why?")
      End If
    Set oFSO = Nothing

End Sub
Here is a way to create your own file. This time I created an Excel file

  Sub NewWorkbook()
         Dim wkb As Workbook, wks As Worksheet

         Set wkb = Workbooks.Add
         Set wks = wkb.Worksheets.Add(After:=wkb.Sheets(wkb.Sheets.Count))
         wks.Name = "January"
         wks.Range("A1").Value = "Sales Data"
         wkb.SaveAs Filename:="SeptSales.xlsx"
     End Sub

My job is done

1 comment:

lanettwagg said...

Casino Review: Get the welcome bonus at Bet365 Casino
Bet365 Casino Review · Mobile banking 충주 출장마사지 · No minimum deposit 서울특별 출장마사지 · 파주 출장안마 Mobile bonuses · No bonus code. Rating: 4 · ‎Review 안동 출장안마 by 대구광역 출장마사지 TJ Hub


Arduino (1) C (3) Clojure (3) Perl (1) the other side (8) VBA (1)

micro's shared items