Looking for explanations of how this code works.

[PeterOD]

Hi all.

New user here. I have a specific query regarding some VBA. I am new fairly new to VBA, and I am trying to wrap my head around whats going on in the code below.

This code pulls values from a CSV file into a spreadsheet, the sheet populates with the values in the correct cell. It has problems though in that it seems to be missing some values. I am trying to understand what each part does and how this code is determining which value goes in which cell. I get the clear sheet, which clears values before moving on and running the next module.

I have been looking at this for days and not getting very far so any glimpse of expertise i can gleen details from will be very much appreciated.

Many thanks for any help you guys can give.

* edit, these files need to be in the same folder i beleive. Ive added the code hore to see if it will spur a reply

 

Option Explicit

Const NUM_OF_SHEETS As Integer = 11

Private Type sheetDataType
  sheetName As String
  rowIndex As Integer
End Type

Private Sub Workbook_Open()
  Call ReadVxInput
End Sub

'************************************************
' Read data from Vertex BD input file
'************************************************
Private Sub ReadVxInput()
  Dim path As String
  Dim MyRecord As String
  Dim typeStr As String
  Dim prevTypeStr As String
  Dim codeStr As String
  Dim prevCodeStr As String
  Dim valueStr As String
  Dim value2Str As String
  Dim value3Str As String
  Dim value4Str As String
  Dim value5Str As String
  Dim value6Str As String
  Dim value7Str As String
  Dim unitStr As String
  Dim rowIndex As Integer
  Dim headerDataIndex As Integer
  Dim inDataLoop As Boolean
  Dim pos As Integer
  Dim i As Integer
  Dim loopMax As Integer
  Dim floor As String
  Dim prevFloor As String
  Dim sheetData(NUM_OF_SHEETS) As sheetDataType
  Dim MyRecordCopy As String
  Dim minRowCount As Integer
  Dim listType As Integer
  Dim rowCount As Integer
  Dim listMaxRows As Integer
  Dim floorChanged As Integer
  
  On Error GoTo Err:
  ' Maximum number of items in dynamic list
  listMaxRows = 20
  
  Dim ret As Integer
  ret = MsgBox("Do you want to read and update data from excel-input file?", vbYesNo)
  If (ret <> vbYes) Then
    Exit Sub
  End If
  rowIndex = 1
  rowCount = 0
  floorChanged = 0
  headerDataIndex = 1
  inDataLoop = False
  Call initSheetData(sheetData) 'init sheet data
 'Call clearData(sheetData) 'remove all from input sheets
  path = ActiveWorkbook.path & "\excel-input.txt"
  Open path For Input As #1 'open data file
    Do While Not EOF(1) 'loop whole file
    Line Input #1, MyRecord ' Read record.
    MyRecordCopy = Trim(MyRecord)
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    floor = Trim(Left(MyRecordCopy, pos - 1)) 'which foor
    If (hasSheet(floor) = True) Then
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    typeStr = Trim(Left(MyRecordCopy, pos - 1)) 'structure type
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    codeStr = Trim(Left(MyRecordCopy, pos - 1)) 'code
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    valueStr = Trim(Left(MyRecordCopy, pos - 1)) 'value
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    value2Str = Trim(Left(MyRecordCopy, pos - 1)) 'value2
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    value3Str = Trim(Left(MyRecordCopy, pos - 1)) 'value3
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    value4Str = Trim(Left(MyRecordCopy, pos - 1)) 'value4
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    value5Str = Trim(Left(MyRecordCopy, pos - 1)) 'value5
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    value6Str = Trim(Left(MyRecordCopy, pos - 1)) 'value6
    MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
    pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
    value7Str = Trim(MyRecordCopy) 'value7
    
   If (prevFloor <> floor) Then
    ' rowIndex = getRowIndex(floor, sheetData)
      Sheets(floor).Activate
      floorChanged = 1
   End If
       
    listType = 0
    If InStr(typeStr, "LIST") > 0 Then
      listType = 1
      If (prevTypeStr <> typeStr) Or (floorChanged = 1) Then
        ret = FindLocation(typeStr, 1)
        rowCount = 1
        floorChanged = 0
      End If
    End If
    If (listType = 0) Then
        ret = FindLocation(codeStr, 0)
        rowCount = 0
    End If
    If (ret = 1) And (rowCount <= listMaxRows) Then
      If (listType = 1) Then
        Cells(ActiveCell.Row + rowCount, ActiveCell.Column) = codeStr 'add code value into cell, if list type
      End If
      Cells(ActiveCell.Row + rowCount, ActiveCell.Column + 1) = valueStr 'add value into cell
      If (Len(value2Str) > 0) Then
        Cells(ActiveCell.Row + rowCount, ActiveCell.Column + 2) = value2Str 'add value2 into cell
      End If
      If (Len(value3Str) > 0) Then
        Cells(ActiveCell.Row + rowCount, ActiveCell.Column + 3) = value3Str 'add value3 into cell
      End If
      If (Len(value4Str) > 0) Then
        Cells(ActiveCell.Row + rowCount, ActiveCell.Column + 4) = value4Str 'add value4 into cell
      End If
      If (Len(value5Str) > 0) Then
        Cells(ActiveCell.Row + rowCount, ActiveCell.Column + 5) = value5Str 'add value5 into cell
      End If
      If (Len(value6Str) > 0) Then
        Cells(ActiveCell.Row + rowCount, ActiveCell.Column + 6) = value6Str 'add value6 into cell
      End If
      If (Len(value7Str) > 0) Then
        Cells(ActiveCell.Row + rowCount, ActiveCell.Column + 7) = value7Str 'add value7 into cell
      End If
      End If
      prevFloor = floor
      prevTypeStr = typeStr
      prevCodeStr = codeStr
      rowIndex = rowIndex + 1
      rowCount = rowCount + 1
    Else
      MsgBox ("Unknown floor " & floor & ".")
    End If
  Loop
  
Err:
  Close #1
  Range("A1").Select
End Sub

'************************************************
' Find sheet
'************************************************
Private Function hasSheet(sheetName As String) As Boolean
  Dim i As Integer
  Dim sheetObj As Object
  
  For Each sheetObj In Sheets
    If LCase(sheetObj.Name) = LCase(sheetName) Then
      hasSheet = True
      Exit Function
    End If
  Next
  hasSheet = False
End Function

'************************************************
' Clear input data sheets
'************************************************
Private Sub clearData(sheetData() As sheetDataType)
  Dim i As Integer
  Dim sheetObj As Object
  
  For i = 1 To NUM_OF_SHEETS
    For Each sheetObj In Sheets
      If LCase(sheetObj.Name) = LCase(sheetData(i).sheetName) Then
        Sheets(sheetData(i).sheetName).Activate
        Cells.Select
        Selection.ClearContents
        Selection.Interior.ColorIndex = xlNone
        Selection.Font.Bold = False
        Range("A1").Select
      End If
    Next
  Next i
End Sub

'************************************************
' Init sheet data e.g. sheet name and row index.
'************************************************
Private Sub initSheetData(sheetData() As sheetDataType)
  sheetData(1).sheetName = "Ground Floor"
  sheetData(1).rowIndex = 1
  sheetData(2).sheetName = "1. Floor"
  sheetData(2).rowIndex = 1
  sheetData(3).sheetName = "2. Floor"
  sheetData(3).rowIndex = 1
  sheetData(4).sheetName = "3. Floor"
  sheetData(4).rowIndex = 1
  sheetData(5).sheetName = "4. Floor"
  sheetData(5).rowIndex = 1
  sheetData(6).sheetName = "5. Floor"
  sheetData(6).rowIndex = 1
  sheetData(7).sheetName = "6. Floor"
  sheetData(7).rowIndex = 1
  sheetData(8).sheetName = "7. Floor"
  sheetData(8).rowIndex = 1
  sheetData(9).sheetName = "8. Floor"
  sheetData(9).rowIndex = 1
  sheetData(10).sheetName = "Roof"
  sheetData(10).rowIndex = 1
  sheetData(11).sheetName = "Foundation"
  sheetData(11).rowIndex = 1
End Sub

'************************************************
' Get sheets current row index
'************************************************
Private Function getRowIndex(sheetName As String, sheetData() As sheetDataType)
  Dim i As Integer
  
  For i = 1 To NUM_OF_SHEETS
    If (LCase(sheetData(i).sheetName) = LCase(sheetName)) Then
      getRowIndex = sheetData(i).rowIndex
      Exit Function
    End If
  Next i
End Function

'************************************************
' Set sheets current row index
'************************************************
Private Sub setRowIndex(sheetName As String, sheetData() As sheetDataType, rowIndex As Integer)
  Dim i As Integer
  
  For i = 1 To NUM_OF_SHEETS
    If (LCase(sheetData(i).sheetName) = LCase(sheetName)) Then
      sheetData(i).rowIndex = rowIndex
      Exit Sub
    End If
  Next i
End Sub

'************************************************
' Get minimum number of rows for code.
'************************************************
Private Function getMinRowCount(typeStr As String)
  Select Case typeStr
    Case "SOLEPL"
    getMinRowCount = 15
  Case "WD-EXT.B"
    getMinRowCount = 15
  Case "WD-GBL.B"
    getMinRowCount = 15
  Case "WD-INT.B"
    getMinRowCount = 15
  Case "WD-INT.NB"
    getMinRowCount = 15
  Case "WALL_INTB_PART"
    getMinRowCount = 15
  Case "COMP_WINDOW"
    getMinRowCount = 1
  Case "COMP_DOOR_EXT"
    getMinRowCount = 1
  Case "COMP_DOOR_INT"
    getMinRowCount = 1
  Case "FLOOR/LAYER"
    getMinRowCount = 1
  Case "FLOOR/BLOCK"
    getMinRowCount = 1
  Case ""
    getMinRowCount = 0
  Case Else
    MsgBox ("Unknown type """ & typeStr & """")
    getMinRowCount = 0
  End Select
End Function

Private Function FindLocation(textToFind As String, Mode As Integer) As Integer
  Dim ret As Integer
  Dim LookType As String
  On Error GoTo ErrorHandler
  If (Mode = 1) Then
    ActiveSheet.Cells.Find(What:=textToFind, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False).Activate
  Else
    ActiveSheet.Cells.Find(What:=textToFind, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False).Activate
  End If
  FindLocation = 1
  Exit Function
ErrorHandler:
  FindLocation = 0
End Function

[JLGWhiz]

You have several separate procedures there. I doubt that anyone will try to interpret all of them for you. The best way to find out what a procedure does, is to open the vb Editor and use the F8 function key to step trough the procedure one line at a time. You can use the mouse pointer to resize the editor screen so you can see both the code and the worksheet. Theree is nothing magical about VBA code. It simply sends instructions to the compiler which translates them into computer logic and performs the same actions that a user would do manually, only many times faster. Learning what the VBA constants and functions do is the hard part. There are restrictions and limitations that apply to the different methods. You learn those through application trial and error. Most responders on this site will be happy to help you with a problem item in a code, but not many want to spend time translating multiple procedures. That is why people write books to explain how the code works.

[hrlngrv]

I'm going to guess that you inherited this code from a previous employee where you work. Based on one snippet,

Private Function FindLocation(textToFind As String, Mode As Integer) As Integer
  Dim ret As Integer
  Dim LookType As String
  On Error GoTo ErrorHandler
  If (Mode = 1) Then
    ActiveSheet.Cells.Find(What:=textToFind, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False).Activate
  Else
    ActiveSheet.Cells.Find(What:=textToFind, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False).Activate
  End If
  FindLocation = 1
  Exit Function
ErrorHandler:
  FindLocation = 0
End Function

s/he didn't know VBA much better than you claim to. Note that variables ret and LookType are unused.

Unfortunately, this is poor VBA code through having to maintain/fix it to have to learn VBA. However, it that's your job, that YOUR job. Some here may be willing to answer specific questions, but it's unlikely you're going to get roughly US$1,000 worth of VBA code consulting for free.

I'll give this much advice. Make this change.

Private Sub Workbook_Open()
  Stop  '# to step through all the code in the VBA Editor
  Call ReadVxInput
End Sub

That will suspend macro execution as soon as the workbook containing this code is opened. You could then use [F8] to step through the code to see how it works. That may be tedious, but it's the first step I'd take if I weren't allowed to redo everything the way I'd prefer coding it.

[PeterOD]

Thanks for this. I did inherit this but it and surprisingly it was compiled by a software vendor years ago to get values from the design software i use into excel for calculations to be carried out. You say this could be written much better and that you think it would be roughly 1000 us to get the code corrected, that may be something my employer would be prepared to pay. However, in saying that, i do have a personal desire to understand what is going on here and how each element of it works. I will do as you suggest. If i can go through each procedure step by step it would broaden my knowledge. I dont have much programming skills beyond CSS, HMTL and some PHP that i was learning as a hobby for a database app i was trying to create.

Thanks again for your help. Im not looking for it to be completely broken down by someone, just hints here and there to get me off on the correct path so with luck, im in the right place.

[protonLeah]

This macro:ReadVxInput() processes the text/csv file excel-input.txt and distributes the record fields to various workheets according to the floor number.

Instead of reading the file directly into an Excel worksheet, it reads the file, one line (record) at a time into the variable MyRecord (Line Input #1, MyRecord). Each record/line consists of ten comma separated fields.

The fields are examined using the following repeated code:
pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
floor = Trim(Left(MyRecordCopy, pos - 1))
where pos is used to find the left most comma and string to the left of the comma is copied to the associated variable (floor in this case).
After the field is copied, the line is cut from the left up to and including the found comma position.
MyRecordCopy = Trim(Mid(MyRecordCopy, pos + 1))
-----------------------------------------------------------
the destination sheet is determined by the contents of FLOOR variable:
Sheets(floor).Activate

the destination cell is found by Private Function FindLocation(...): ActiveSheet.Cells.Find(What:=textToFind...).Activate

---

There are many areas were that code can be changed. For instance there are seven, such as:

pos = InStr(1, MyRecordCopy, ",", vbTextCompare)
floor = Trim(Left(MyRecordCopy, pos - 1))

where the commas are found in the string, then string trimmed and a value copied to a variable.
The find comma/trim & copy can be replaced with the VBA Split function:
Fields=Split(MyRecord,",") results in a ten element array of values where Floor is element 1, typeStr= 2, etc.

[PeterOD]

Ive kind of refined the problem with our code. It seems to miss the first line of values from the CSV data set. if I move the values from the first row of the dataset to the bottom the VBA pulls them through into the right cells in excel.

[PeterOD]

SOLVED

the issue was not only with the VBA per se, however badly written. The problem I have been pulling my hair out with wsa more contained within the CSV data set. There was nothing in the VBA to deal with the UTF8 marker in the txt file (BOM), so the first line of text was esstintailly corrupt by the BOM and thus the VBA failed.

I have added

Line Input #1, MyRecord ' Read record.
    MyRecord = replace(MyRecord,UTF8_BOM, "")
    MyRecordCopy = Trim(MyRecord)

which removed the BOM and it all works now.

Woopeee. I will now save myself countless lost hours over the course of the years ahead! All it took was 20-30 hrs messing around!

Regards

Peter

[protonLeah]

But, "... I am new fairly new to VBA...I am trying to understand what each part does and how this code is determining which value goes in which cell. ..." That's what I thought I was helping with,

[PeterOD]

That still stands. I am still learning and want to figure out what was going on in this code.
I spent 24hrs over the course of the weekend reading and and trying to figure it out.
. Without being blunt, i was told on this forum to not expect much help because it was circa 1k of software development i was looking for, I figure out the cause of the issue,
and instead of disappearing without a trace, i posted it here. Forgive me for doing so. isn't that what these forms are about.

I genuinely appreciate the wealth of experience in these types of forums, I get that there are a lot of new questions and it can get tedious answering stupid tedious questions too. Dont know what else to say!

[JLGWhiz]

An epiphany!
Regards, JLG

[TMS]

I think the point being made was that it could/would take several hours of anyone's time to track and trace (familiar phrase now) what the code does ... and we don't have the benefit of context. Some of us have been known to do it out of interest, or as a challenge, but it does depend on us having the time (and inclination).

I'm glad you managed to identify the problem and develop a workaround ... and for sharing it.

Perhaps you are better at VBA than you imagine



If you are satisfied with the solution(s) provided, please mark your thread as Solved.


New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save


You may also want to consider thanking those people who helped you by clicking on the little star at the bottom left of their reply to your question.