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