home

-- Excel - Process (loop) through cells in a worksheet
Author Nigel Rivett

This processes all cells in a worksheet.
it is expected to be called from a module which loops through worksheets hence the worksheet is a parameter
The value "SQL Script" needs to be added to the top left cell
The value "SQL Script End" needs to be added to the bottom left cell after the script


The format of the spreadsheet is
The first 10 rows max. as header rows
One of these rows has the first column with a value "Generate Script" and the folowing cell on the row with a "Y" or "N" to control processing.
The table name is expected to be in row 1 column 2

Following this there will be a row with the first column value as "Column Name"
This indicates the begining of the rows and columns to be processed and is the heading row.
The values in columns in this row are used to add values to the database - the column loop continues until there is a blank heading column value.
The loop processes each row until there is an empty cell in the first column
For each cell an entry is created using the heading value
An sql statement is generated to insert into a table with the table name, heading and cell value
A subroutine WriteLine is then called to add the line to a worksheet. The worksheet has previously been created - see create worksheet.

This leaves us with a worksheet with sql statements that can be executed

Sub AddTableMetadata(ws As Excel.Worksheet, sTableType As String)

    Dim sTableName As String
    Dim sGenerateScript As String
    
    ' Find the "Generate script?" cell in the first 10 rows, first column.
    ' Take the value from the next column (Y/Yes) default to N.
    Dim r As Integer
    
    sGenerateScript = "N"
    For r = 1 To 10
        If ws.Cells(r, 1).Value = "Generate script?" Then
            If ws.Cells(r, 2).Value = "Y" Or ws.Cells(r, 2).Value = "Yes" Then _
                sGenerateScript = "Y"
            Exit For
        End If
    Next
    
    ' Generate the add metadata for this entry.
    If sGenerateScript = "Y" Then
    
        giRow = giRow + 5
        sTableName = ws.Cells(1, 2)
        'The Drop table statement is useful if you're not dropping & recreating the entire database.
        Call WriteLine("delete DW_Metadata where TableName = '" & sTableName & "'")
        Call WriteLine("GO")
        Call WriteLine("")

        Call WriteTableMetadata(sTableName, ws, sTableType)
    End If
End Sub

Sub WriteTableMetadata(sTableName As String, ws As Excel.Worksheet, sTableType As String)
    Dim i As Integer, j As Integer, k As Integer
    Dim iColCnt As Integer
    Dim sXColPropName() As String
    Dim sXColPropGen() As String
    Dim sColName() As String
    Dim sColProp() As String
    Dim sDataType As String
    Dim sNull As String
    Dim sColInfo As String
    Dim sPK As String
    Dim sLine As String
    Dim sFK As String
    Dim sDefault As String
    Dim sColList As String
    Dim sUnkMember As String
    Dim sUnkMemberElement As String
    
    Dim iHeadingsRow As Integer
    Dim iColRow As Integer
    Dim iPropertyCol As Integer
    ' Find the cell in column one that's labeled "Column Name".
    ' This must be in the first column and indicates the start of the column list
    For iHeadingsRow = 5 To 20     'Just in case someone adds or subtracts some rows from the top of the spreadsheet.
        If ws.Cells(iHeadingsRow, 1) = "Column Name" Then
            Exit For
        End If
    Next
    
    ' Now loop throuh all the columns and all the heading writing the values to the metadata table
    iColRow = iHeadingsRow + 2
    Do While ws.Cells(iColRow, 1) <> ""
        sLine = "insert DW_Metadata select '" & sTableName & "', '" & ws.Cells(iColRow, 1) & "', 'ColSeq', '" & iColRow - iHeadingsRow - 1 & "'"
        Call WriteLine(sLine)
        iPropertyCol = 1
        Do While ws.Cells(iHeadingsRow, iPropertyCol) <> ""
            If ws.Cells(iColRow, iPropertyCol) <> "" And ws.Cells(iHeadingsRow + 1, iPropertyCol) = "Y" Then
                sLine = "insert DW_Metadata select '" & sTableName & "', '" & ws.Cells(iColRow, 1) & "', '" & ws.Cells(iHeadingsRow, iPropertyCol) & "', '" & Replace(ws.Cells(iColRow, iPropertyCol), "'", "''") & "'"
                Call WriteLine(sLine)
            End If
            iPropertyCol = iPropertyCol + 1
        Loop
        iColRow = iColRow + 1
    Loop
End Sub
Sub WriteLine(sText As String)
'Write a line to the script
    gwsMetadataScript.Cells(giRow, 1).Value = sText
    giRow = giRow + 1
End Sub

home