Cell Selection of No blank cells via specialcells (xlCellTypeConstants + xlCellTypeFormulas)

It’s a bit frustrating if you have to select any NoBlank cells (both xlCellTypeConstants and xlCellTypeFormulas) using the SpecialCells Method, as there is not one constant that handles both of them, and it goes throwing errors if any range Is Nothing. So here is the code to properly select no blank cells. You can also combine with Selection range and with formated cells to refine more the selection.

Continue reading “Cell Selection of No blank cells via specialcells (xlCellTypeConstants + xlCellTypeFormulas)”

Excel to App (with VBA macros)

This is a continuation (or better, a prologue) of this post, where I’m trying to accomplish an “Excel to web App” solution that can handle macros (VBA to JavaScript). It’s only shown a little piece of code on how to get an “If” block to JS, but there is more done waiting to create an online service to be published.

Continue reading “Excel to App (with VBA macros)”

LEAN

Introduction

The Lean Production presents an alternative vision of conventional production, introducing a novel approach that is taking more strength every day worldwide. This new perspective, based on the Toyota Production System (TPS), addresses the causes of many of the problems that limit efficiency, focusing on the reduction of losses along the productive flow, minimizing waste and adding systematically value the manufacturing process.

I’ll not bother you about the history of the LEAN philosophy, you can check it in Wikipedia article.

The philosophy behind LEAN is the ‘Total Productive Maintenance’ or ‘Total Productive Manufacturing’, and for TOTAL, meaning ‘total participation’ – that’s, everyone in the company – playing an active role in productive flow, adding value to the organization by developing its own staff and associated (suppliers and subcontractors) and continuously solve root problems generating organizational learning. The goal of the system is to eliminate “waste” or “loss” (Muda in Japanese).

I would recomend the following site to get more information about LEAN and TPM.

BIM

Introduction

BIM (Building Information Modelling, or let’s say it, Management) is the “digital” language with which the Construction sector should be able to produce more efficiently.

It will cause a deep digitalization of all procedures and stages, and implies a interdisciplinary collaboration, supported by new technologies, that can bring more efficiency in the job done. So, it’s very likely to be the most important revolution that this sector has experienced.

Digitization gives the opportunity to bring, to the Construction sector, values of industrial production that allow access to higher levels of quality, control, traceability, productivity and efficiency, which should help achieve a more sustainable activity.

But don’t get me wrong, the use of a specific technology is not, by itselft, a guarantee to a better work; regardless of the technology they use, the work depends on the professionals using it, and how they use it.

One final thing to note, with which we have started. BIM stands for:

  •  “Building” (or “construction”, and even the action of “build”), 
  • “Information”, relating it with classified, stored data, with the capacity to be transmitted and later processed with computer technology.
  • “Modelling”, relating to a 3D representation model or simplified idealization of something. But we must consider here that BIM methodology, in the end, is more related to the global management of the whole “building”, throughout the phases of life (planning, project, construction and exploitation).

The digital representation must comprehend both the physical and the functional characteristics of the facility.

It must serve as a knowledge resource for information about a facility forming a reliable basis for decisions during its life-cycle from conception to demolition. It must let insert, extract, update or modify information in the BIM to support and reflect the roles of the stakeholders involved to help achieve the best possible efficiency, so it enables
those who interact with the model to optimize their actions, resulting in a greater whole life value for the asset.

Current situation

The Construction sector has some peculiarities:

  • Low productivity indexes.
  • Significant specific weight in the economy of any country.
  • Mobilizes a very significant and diversified workforce.
  • Operates in a very sequential manner, with agents that intervene with very heterogeneous levels of interconnection.

All this leads to each stakeholder having their own interests, and will hardly align them with the other agents involved.

In addition, legislation in the public sphere seems to promote this way of working.

It faces several requirements of a more digital world:

  • Increasingly demanding regulations
  • Complex technical facilities
  • Need to reduce energy needs
  • Introduction of ecodesign
  • Introduction of sensorics and efficient management
  • Reduction of environmental impacts
  • Greater demand for quality
  • Elimination of unforeseen extra costs
  • Adjusted control of temporary schedules

And it must face them adapting the way things are done with the help of new technological possibilities in a methodology that BIM can represent.

BIM clearly has to sides, one technological , another one of process.

  • From the technological point of view, we have to see it as a set of software applications and information hosting systems that can allow more efficient production work. New technologies tools arise in a linear way, and are usually adopted continuously without producing large jumps in the way of operating. 
  • From the point of view as a process, it supposes the establishment of a work of collaboration between the diverse interested parties, that covers all the cycle of life, being based on the new software and the technologies of communication. The change in a process is an always more disruptive factor.

The sector is very impervious to changes and investment in technology leading to the automatization or optimization of process. The reasons must be sought in:

  • the scarce industrialization of processes,
  • the atomization of industry,
  • poorly collaborative work systems,
  • poorly qualified labor,
  • a difficult capitalization of knowledge acquired in daily practice,
  • the rigidity of contracting systems,
  • sequentiality,
  • etc.

The sector has the opportunity to carry out the revolution of incorporating new technologies of manufacturing, models of management and business, collaborative forms of greater intensity, using the digitization as a thread.

Sequentiality

There is an inefficiency when each agent enters and leaves the project at a specific time, having had a very low level of dialogue with respect to the other agents. If they do not dialogue, they probably can not contrast the different criteria in early phases, when it is easy to make decisions. Worse still, if the time they are tied to the project is short, they will never get a global vision that can lead to better options.

BIM_ActualWorkflow

It’s needed a more imbricated implication of the stakeholders, with the intensity representing their role in the project, based on their experience, in the initial stages of development when decisions are more efficient and involve a lower cost. Introducing changes on the fly in the construction phase is inefficient, and can derive in clashes not well pondered.

Integrated Project Delivery

The IPD (Integrated Project Delivery) methodology. Is about making decisions based on the experience of the different agents, in the initial stages of development of a project, just when making decisions, and changes in criteria, are more efficient and involve a lower cost.

BIM_IDP_MacLeamy

The alignment of interests

A certain cultural change is desirable, in which the different agents understand the need to work as a team that aims for a common goal. This is a cultural shift hard to achieve, as business practice is conducted by each agent seeking its own maximum economic benefit, that does not have to favor the project considered globally.

Therefore, each stakeholder applies resources and strategies that, even being favorable to their particular interest, it can be detrimental to other agents, or even to the final outcome of the project.

To overcome this difficulty, the problem of sequentiality must be solved, forcing the different agents to collaborate during the different phases of the project. Ideally this could be achieved by the parties understanding that they will achieve a greater particular benefit by acting together than acting separately; or, directly, forcing collaboration.

Current business models, and hiring, clash with this idea.

The complete life-cycle

All the stakeholders should consider the project as the sum of all the phases through which an asset passes: Planning, Design, Construction, Exploitation and End of useful life, and not only taking to consideration the part in which they are affected and bounded to it.

BIM_Lifecycle

BIM_Lifecycle_applications.jpg

BIM benefits:

  • Information about all the elements can be used throughout the building lifecycle from construction to maintenance.
  • Provides a 3D model that serves as a centralized location for all the parties involved to put in and pull out the information.
  • Provides a 4D model that is used for scheduling during construction, modification and maintenance phase.
  • Provides a 5D model to reduce the expenses and maintenance costs.
  • Provides a 6D model to answer all the questions like who, what, when, and how of the different aspects of the building lifecycle.

Benefits of BIM for facility management:

  • Space Management: BIM gives a proper know-how of the space used thus increasing the scope of reducing vacant spaces. Ultimately, it reduces the expenses required for maintenance.
  • Efficient Maintenance: Maintenance of information becomes tough when a large amount of data is involved in big projects. BIM eliminates months of work by providing a streamlined maintenance of the information.
  • Efficient Energy Usage: Through BIM, facility managers can avoid negative impacts on the environment by helping find energy alternatives. Hence, it optimizes the building performance.
  • Affordable Renovations: BIM Services help in providing better information on the existing state of the project. Hence, reducing the complexity, time and money required to renovate it.
  • Lifecycle Management: BIM supports an in-depth knowledge of the materials to be used for lower maintenance cost. Some materials are costly compared to others but they are more durable hence reducing the overall lifecycle costs.

 

VBA decode URI data

It’s not only img block that accepts Data URIs, in HTML5 audio and video also accept it as a source, as well as standard file URLs.
URI information has this form:

data:[<MIME-type>][;charset=<encoding>][;base64],<data>

Would be interesting to hide -hindering download- some graphical elements as binary text, thus needed to encode/decode. So rearranging code from here got a functional tool for this task.

Option Explicit

Private Const clOneMask As Long = 16515072          '000000 111111 111111 111111
Private Const clTwoMask As Long = 258048             '111111 000000 111111 111111
Private Const clThreeMask As Long = 4032             '111111 111111 000000 111111
Private Const clFourMask As Long = 63               '111111 111111 111111 000000

Private Const clHighMask As Long = 16711680         '11111111 00000000 00000000
Private Const clMidMask As Long = 65280             '00000000 11111111 00000000
Private Const clLowMask As Long = 255               '00000000 00000000 11111111

Private Const cl2Exp18 As Long = 262144             '2 to the 18th power
Private Const cl2Exp12 As Long = 4096               '2 to the 12th
Private Const cl2Exp6 As Long = 64                  '2 to the 6th
Private Const cl2Exp8 As Long = 256                 '2 to the 8th
Private Const cl2Exp16 As Long = 65536              '2 to the 16th

Public Sub sFileEncode64()
    Dim iFileIn As Integer
    Dim strFullPathFile As String
    Dim sBinary As String

    iFileIn = VBA.FreeFile()
    strFullPathFile = VBA.Environ$("UserProfile") & "\Documents\###." & "png"
    Open strFullPathFile For Binary As #iFileIn
    sBinary = String$(LOF(iFileIn), Chr$(0))
    Get #iFileIn, , sBinary
    Close #iFileIn

    Debug.Print Encode64(sBinary)
End Sub

Public Function sTest_DecodeURI()
    Dim strURI As String
    strURI = _
           "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABGdBTUEAALGPC/xhBQAAAAZiS0dEAP8A/wD/oL2nkwAAAAlwSFlzAAALEwAACxMBAJqcGAAAAAd0SU1FB9oEBxcZFmGboiwAAAAIdEVYdENvbW1lbnQA9syWvwAAAuFJREFUOMvtlUtsjFEUx//n3nn0YdpBh1abRpt4LFqtqkc3jRKkNEIsiIRIBBEhJJpKlIVo4m1RRMKKjQiRMJRUqUdKPT71qpIpiRKPaqdF55tv5vvusZjQTjOlseUkd3Xu/3dPzusC/22wtu2wRn+jG5So/OCDh8ycMJDflehMlkJkVK7KUYN+ufzA/RttH76zaVocDptRxzQtNi3mRWuPc+6cKtlXZ/sddP2uu9uXlmYXZ6Qm8v4Tz8lhF1H+zDQXt7S8oLMXtbF4e8QaFHjj3kbP2MzkktHpiTjp9VH6iHiA+whtAsX5brpwueMGdONdf/2A4M7ukDs1JW662+XkqTkeUoqjKtOjm2h53YFL15pSJ04Zc94wdtibr26fXlC2mzRvBccEbz2kiRFD414tKMlEZbVGT33+qCoHgha81SWYsew0r1uzfNylmtpx80pngQQ91LwVk2JGvGnfvZG6YcYRAT16GFtW5kKKfo1EQLtfh5Q2etT0BIWF+aitq4fDbk+ImYo1OxvGF03waFJQvBCkvDffRyEtxQiFFYgAZTHS0zwAGD7fG5TNnYNTp8/FzvGwJOfmgG7GOx0SAKKgQgDMgKBI0NJGMEImpGDk5+WACEwEd0ywblhGUZ4Hw5OdUekRBLT7DTgdEgxACsIznx8zpmWh7k4rkpJcuHDxCul6MDsmmBXDlWCH2+XozSgBnzsNCEE4euYV4pwCpsWYPW0UHDYBKSWu1NYjENDReqtKjwn2+zvtTc1vMSTB/mvev/WEYSlASsLimcOhOBJxw+N3aP/" & _
           "SjefNL5GePZmpu4kG7OPr1+tOfPyUu3BecWYKcwQcDFmwFKAUo90fhKDInBCAmvqnyMgqUEagQwCoHBDc1rjv9pIlD8IbVkz6qYViIBQGTJPx4k0XpIgEZoRN1Da0cij4VfR0ta3WvBXH/rjdCufv6R2zPgPH/e4pxSBCpeatqPrjNiso203/5s/zA171Mv8+w1LOAAAAAElFTkSuQmCC"
    Call Decode64(strURI)
End Function

Public Function Encode64(ByVal sString As String) As String
    Dim bTrans(63) As Byte
    Dim lPowers8(255) As Long
    Dim lPowers16(255) As Long
    Dim bOut() As Byte
    Dim bIn() As Byte
    Dim lChar As Long
    Dim lTrip As Long
    Dim iPad As Integer
    Dim lLen As Long
    Dim lTemp As Long
    Dim lPos As Long
    Dim lOutSize As Long

    For lTemp = 0 To 63                                 'Fill the translation table.
        Select Case lTemp
            Case 0 To 25
                bTrans(lTemp) = 65 + lTemp              'A - Z
            Case 26 To 51
                bTrans(lTemp) = 71 + lTemp              'a - z
            Case 52 To 61
                bTrans(lTemp) = lTemp - 4               '1 - 0
            Case 62
                bTrans(lTemp) = 43                      'Chr(43) = "+"
            Case 63
                bTrans(lTemp) = 47                      'Chr(47) = "/"
        End Select
    Next lTemp

    For lTemp = 0 To 255                                'Fill the 2^8 and 2^16 lookup tables.
        lPowers8(lTemp) = lTemp * cl2Exp8
        lPowers16(lTemp) = lTemp * cl2Exp16
    Next lTemp

    iPad = Len(sString) Mod 3                           'See if the length is divisible by 3
    If iPad Then                                        'If not, figure out the end pad and resize the input.
        iPad = 3 - iPad
        sString = sString & String(iPad, Chr(0))
    End If

    bIn = StrConv(sString, vbFromUnicode)               'Load the input string.
    lLen = ((UBound(bIn) + 1) \ 3) * 4                  'Length of resulting string.
    lTemp = lLen \ 72                                   'Added space for vbCrLfs.
    lOutSize = ((lTemp * 2) + lLen) - 1                 'Calculate the size of the output buffer.
    ReDim bOut(lOutSize)                                'Make the output buffer.

    lLen = 0                                            'Reusing this one, so reset it.

    For lChar = LBound(bIn) To UBound(bIn) Step 3
        lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2)    'Combine the 3 bytes
        lTemp = lTrip And clOneMask                     'Mask for the first 6 bits
        bOut(lPos) = bTrans(lTemp \ cl2Exp18)           'Shift it down to the low 6 bits and get the value
        lTemp = lTrip And clTwoMask                     'Mask for the second set.
        bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12)       'Shift it down and translate.
        lTemp = lTrip And clThreeMask                   'Mask for the third set.
        bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6)        'Shift it down and translate.
        bOut(lPos + 3) = bTrans(lTrip And clFourMask)   'Mask for the low set.
        If lLen = 68 Then                               'Ready for a newline
            bOut(lPos + 4) = 13                         'Chr(13) = vbCr
            bOut(lPos + 5) = 10                         'Chr(10) = vbLf
            lLen = 0                                    'Reset the counter
            lPos = lPos + 6
        Else
            lLen = lLen + 4
            lPos = lPos + 4
        End If
    Next lChar

    If bOut(lOutSize) = 10 Then lOutSize = lOutSize - 2 'Shift the padding chars down if it ends with CrLf.

    If iPad = 1 Then                                    'Add the padding chars if any.
        bOut(lOutSize) = 61                             'Chr(61) = "="
    ElseIf iPad = 2 Then
        bOut(lOutSize) = 61
        bOut(lOutSize - 1) = 61
    End If

    Encode64 = StrConv(bOut, vbUnicode)                 'Convert back to a string and return it.

End Function

Public Function Decode64(ByVal sString As String) As Boolean
    Dim lgPosition As Long
    Dim strURI As String
    Dim strMIMEtype As String
    Dim strData As String

    'data:[][;charset=][;base64],
    'data:image/png;base64,
    'data:audio/ogg;base64,
    'data:video/webm;base64,
    'data:video/mp4;base64,

    lgPosition = 1
    lgPosition = VBA.InStr(lgPosition, sString, "/")
    strMIMEtype = VBA.Mid$(sString, lgPosition + 1, VBA.InStr(lgPosition, sString, ";") - lgPosition - 1)
    sString = VBA.Mid$(sString, VBA.InStr(1, sString, ",") + 1)

    Dim bOut() As Byte
    Dim bIn() As Byte
    Dim bTrans(255) As Byte
    Dim lPowers6(63) As Long
    Dim lPowers12(63) As Long
    Dim lPowers18(63) As Long
    Dim lQuad As Long
    Dim iPad As Integer
    Dim lChar As Long
    Dim lPos As Long
    Dim lTemp As Long
    Dim lgRetVal As Long

    sString = Replace(sString, vbCr, vbNullString)      'Get rid of the vbCrLfs.  These could be in...
    sString = Replace(sString, vbLf, vbNullString)      'either order.

    lTemp = Len(sString) Mod 4                          'Test for valid input.
    If lTemp Then
        GoTo ErrControl
        'Call Err.Raise(vbObjectError, "MyDecode", "Input string is not valid Base64.")
    End If

    If InStrRev(sString, "==") Then                     'InStrRev is faster when you know it's at the end.
        iPad = 2                                        'Note:  These translate to 0, so you can leave them...
    ElseIf InStrRev(sString, "=") Then                  'in the string and just resize the output.
        iPad = 1
    End If

    For lTemp = 0 To 255                                'Fill the translation table.
        Select Case lTemp
            Case 65 To 90
                bTrans(lTemp) = lTemp - 65              'A - Z
            Case 97 To 122
                bTrans(lTemp) = lTemp - 71              'a - z
            Case 48 To 57
                bTrans(lTemp) = lTemp + 4               '1 - 0
            Case 43
                bTrans(lTemp) = 62                      'Chr(43) = "+"
            Case 47
                bTrans(lTemp) = 63                      'Chr(47) = "/"
        End Select
    Next lTemp

    For lTemp = 0 To 63                                 'Fill the 2^6, 2^12, and 2^18 lookup tables.
        lPowers6(lTemp) = lTemp * cl2Exp6
        lPowers12(lTemp) = lTemp * cl2Exp12
        lPowers18(lTemp) = lTemp * cl2Exp18
    Next lTemp

    bIn = StrConv(sString, vbFromUnicode)               'Load the input byte array.
    ReDim bOut((((UBound(bIn) + 1) \ 4) * 3) - 1)       'Prepare the output buffer.

    For lChar = 0 To UBound(bIn) Step 4
        lQuad = lPowers18(bTrans(bIn(lChar))) + lPowers12(bTrans(bIn(lChar + 1))) + _
                lPowers6(bTrans(bIn(lChar + 2))) + bTrans(bIn(lChar + 3))           'Rebuild the bits.
        lTemp = lQuad And clHighMask                    'Mask for the first byte
        bOut(lPos) = lTemp \ cl2Exp16                   'Shift it down
        lTemp = lQuad And clMidMask                     'Mask for the second byte
        bOut(lPos + 1) = lTemp \ cl2Exp8                'Shift it down
        bOut(lPos + 2) = lQuad And clLowMask            'Mask for the third byte
        lPos = lPos + 3
    Next lChar

    If iPad Then
        ReDim Preserve bOut(LBound(bOut) To UBound(bOut) - iPad) 'Chop off any extra bytes.
    End If

    Dim iFileOut As Integer
    iFileOut = VBA.FreeFile()
    Open VBA.Environ$("UserProfile") & "\Documents\###." & strMIMEtype For Binary As #iFileOut
    Put #iFileOut, , bOut()
    Close #iFileOut

    'StrConv(bOut, vbUnicode)                     'Convert back to a string.
    Decode64 = True

ExitProc:
    Exit Function

ErrControl:
    lgRetVal = VBA.MsgBox("Input string is not valid Base64.", vbCritical, "W A R N I N G")
    GoTo ExitProc
End Function

 

VBA validation list values

If you want to get the values that cell valuation can handle, use this piece of code:

Private Sub sGetValidationList()
If Intersect(ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation), Selection) Is Nothing Then
Else
Call fGetValidationList(Selection, ";")
End If
End Sub

Private Function fGetValidationList(ByVal Target As Excel.Range, _
Optional ByVal strSeparator As String = ",") As String()
Dim rgList As Range
Dim strList As String
Dim strWsh As String
Dim lgPosition As Long

Dim aValidation() As String
Dim myVar As Variant
Dim myItem As Variant
Dim lgItem As Long

If Intersect(Target.Parent.Cells.SpecialCells(xlCellTypeAllValidation), Target) Is Nothing Then
Else
' Get the formula in the data validation
strList = Target.Validation.Formula1

' Check if it has an = sign (case has a range or a named range)
If VBA.InStr(1, strList, "=") > 0 Then
lgPosition = VBA.InStr(1, strList, "!")
If lgPosition > 0 Then
lgPosition = 1
strWsh = VBA.Mid$(strList, 1, VBA.InStr(1, strList, "!") - 1)
strWsh = VBA.Replace$(strWsh, "=", "")
strWsh = VBA.Replace$(strWsh, "'", "")
strList = VBA.Mid$(strList, VBA.InStr(1, strList, "!") + 1)
myVar = ThisWorkbook.Worksheets(strWsh).Range(strList).Value2
Else
myVar = Target.Parent.Range(VBA.Replace$(strList, "=", "")).Value2
End If
Else
' Case with a set of valid values
If InStr(1, strList, strSeparator) > 0 Then
myVar = Split(strList, strSeparator)
Else
aValidation = VBA.Split(strList, vbCrLf)
End If
End If

ReDim Preserve aValidation(LBound(myVar, 1) To UBound(myVar, 1))
lgItem = LBound(aValidation) - 1
For Each myItem In myVar
lgItem = lgItem + 1
aValidation(lgItem) = myItem
Next myItem
Erase myVar
fGetValidationList = aValidation
End If

End Function
[/sourcecode]

JavaScript: editable and resizable table

I’m a complete newbie in JavaScript language, but I’m trying to get on it. For long I’ve wondering if via JavaScript an HTML cable can be edited and resized (not only by means of shape, but to add rows and columns).

So asking google I reached some pages where code were exposed. Some were for resizing, some were for editing, some were for adding rows and other to add columns, and finally others were for sort and reorder elements. They were so interesting alone for themselves, that I supposed that combined, they will be ashtonishing. So did I. And here is the final code (the source links from were the codes came from are referred as comments in the code).

As there is something wrong with the javaScript code parser of wordpress, the code is linked in this file.

Database maker

In last post we were talking about how to distinguish between type of variables. From there, we can try to see if for any given table we can extract characteristics and mount a functional analysis of the database from a sample set of the table.

For that to be achieved, something like the following Database analyser can be used. It will also detect link to Names so data can be restricted to some sources.

Note: it needs the functions from this post.

Option Explicit
Private Const g_Base As Long = 0

Private Sub sDataBase_Analyzer()
' Given a database table, characterize the fields
Dim rgTable As Excel.Range
Dim rgHeaders As Excel.Range
Dim rgColumn As Excel.Range
Dim oCell As Excel.Range
Dim oCellLinked As Excel.Range
Dim rgFormulas As Excel.Range
Dim oName As Excel.Name
Dim bName As Boolean
Dim bHeaders As Boolean
Dim aField() As String
Dim aCarrousel() As String
Dim lgField As Long
Dim strField As String
Dim lgDeclaration As Long
Dim lgDeclarationOld As Long
Dim lgItem As Long
Dim lgCarrousel As Long
Dim bCarrousel As Boolean

Set rgTable = Selection 'Application.InputBox(Prompt:="Select table", Title:="", Type:=8, Default:="$A$1")
If vbYes = VBA.MsgBox("Table has headers?", vbYesNo, "Headers on first row?") Then bHeaders = True

ReDim Preserve aField(g_Base To rgTable.Columns.Count - 1 + g_Base)

lgField = g_Base - 1
If bHeaders Then
Set rgHeaders = rgTable.Rows(1)
For Each oCell In rgHeaders.Columns.Cells
If Not IsEmpty(oCell) Then
lgField = lgField + 1
strField = VBA.Trim$(oCell.Value2)
strField = VBA.Replace$(strField, " ", "_")
aField(lgField) = strField

' Capitalize string...
'.............ToDo
End If
Next oCell
End If

lgField = g_Base - 1
For Each rgColumn In rgTable.Columns
lgDeclaration = 0
If Not IsEmpty(rgColumn.Value2(1, 1)) Then
lgField = lgField + 1
lgCarrousel = g_Base - 1
For Each oCell In rgColumn.Cells
If (bHeaders And oCell.Row = rgHeaders.Row) Then
lgDeclarationOld = VarDeclaration(oCell.Offset(1, 0).Value2)
Else
If Not IsEmpty(oCell) Then
lgDeclaration = VarDeclaration(oCell.value)
If VBA.Abs(lgDeclarationOld) < VBA.Abs(lgDeclarationOld) Then
If lgDeclarationOld = 32768 Then
aField(lgField) = VBA.Replace$(aField(lgField), " As Integer", " As Long")
Exit For
End If
ElseIf Not bHeaders Then
If VBA.Abs(oCell.value) >= 32768 Then
aField(lgField) = VBA.Replace$(aField(lgField), " As Integer", " As Long")
Exit For
End If
End If
Next oCell

Case Is = 2
aField(lgField) = aField(lgField) & " As Double"

' Find typical values:
For Each oCell In rgColumn.Cells
If Not (bHeaders And oCell.Row = rgHeaders.Row) Then
If 1.401298E-45 >= VBA.Abs(oCell.value) Or VBA.Abs(oCell.value) >= 3.402823E+38 Then
aField(lgField) = VBA.Replace$(aField(lgField), " As Single", " As Double")
Exit For
End If
ElseIf Not bHeaders Then
If 1.401298E-45 >= VBA.Abs(oCell.value) Or VBA.Abs(oCell.value) >= 3.402823E+38 Then
aField(lgField) = VBA.Replace$(aField(lgField), " As Single", " As Double")
Exit For
End If
End If
Next oCell

Case Is = 3
aField(lgField) = aField(lgField) & " As Date"

Case Is = 4
aField(lgField) = aField(lgField) & " As String"

On Error Resume Next
Set rgFormulas = rgColumn.SpecialCells(xlCellTypeFormulas).Cells
On Error GoTo 0

If Not rgFormulas Is Nothing Then ' Links to somewhere else
For Each oCell In rgColumn.SpecialCells(xlCellTypeFormulas).Cells
If oCell.Precedents.Count = 1 Then
Set oCellLinked = oCell.Precedents.Item(1)
For Each oName In oCell.Parent.Names
If Not Intersect(oCell.Precedents.Item(1), oName.RefersToRange) Is Nothing Then
If Not oName.Name Like "*_FilterDatabase" Then
If oName.RefersToRange.Columns.Count = 1 Then
bName = True ' --> oName.Name
Exit For
End If
End If
End If
Next oName
End If
If bName Then
Debug.Print oName.Name
Exit For
End If
Next oCell
Set rgFormulas = Nothing

Else
' Find validation list
lgCarrousel = g_Base
ReDim Preserve aCarrousel(g_Base To lgCarrousel)
aCarrousel(lgCarrousel) = rgColumn.Value2(1, 1)
For Each oCell In rgColumn.Cells
If VBA.Abs(lgDeclaration) = 4 Then 'String
If IsBoolean(oCell.Value2) Then
aField(lgField) = VBA.Replace$(aField(lgField), " As String", " As Boolean")
Exit For

ElseIf Not (Not aCarrousel) Then
bCarrousel = False
For lgItem = LBound(aCarrousel) To UBound(aCarrousel)
If Not (bHeaders And oCell.Row = rgHeaders.Row) Then
If aCarrousel(lgItem) = oCell.Value2 Then
bCarrousel = True
Exit For
End If
End If
Next lgItem
Else
bCarrousel = True
End If

If (bHeaders And Not (oCell.Row = rgHeaders.Row)) Or Not bHeaders Then
If Not bCarrousel Then
If Not IsEmpty(oCell.Value2) Then
lgCarrousel = lgCarrousel + 1
ReDim Preserve aCarrousel(g_Base To lgCarrousel)
aCarrousel(lgCarrousel) = oCell.Value2
End If
End If
End If
End If
Next oCell

' Find validation list
If bHeaders Then
If rgColumn.SpecialCells(xlCellTypeConstants).Cells.Count > UBound(aCarrousel) - LBound(aCarrousel) + 1 Then
Debug.Print VBA.Join(aCarrousel(), "/")
End If
Else
If rgColumn.SpecialCells(xlCellTypeConstants).Cells.Count > UBound(aCarrousel) - LBound(aCarrousel) Then
Debug.Print VBA.Join(aCarrousel(), "/")
End If
End If
End If

Case Is = -1: aField(lgField) = aField(lgField) & "() As Long"
Case Is = -2: aField(lgField) = aField(lgField) & "() As Double"
Case Is = -3: aField(lgField) = aField(lgField) & "() As Date"
Case Is = -4: aField(lgField) = aField(lgField) & "() As String"
End Select
End If
Next rgColumn
Stop

Debug.Print VBA.Join(aField(), vbNewLine)
End Sub

Public Function VarDeclaration(ByVal strVarCheck As String) As Long ' String
If IsLong(strVarCheck) Then
VarDeclaration = 1 'Long/Integer/Byte
If VBA.InStr(1, strVarCheck, vbLf) > 0 Then VarDeclaration = -1 ' Is array
ElseIf IsDouble(strVarCheck) Then
VarDeclaration = 2 'Double/Single
If VBA.InStr(1, strVarCheck, vbLf) > 0 Then VarDeclaration = -2 ' Is array
ElseIf IsDate(strVarCheck) Then
VarDeclaration = 3 'Date
If VBA.InStr(1, strVarCheck, vbLf) > 0 Then VarDeclaration = -3 ' Is array
ElseIf IsString(strVarCheck) Then
VarDeclaration = 4 'String
'If VBA.InStr(1, strVarCheck, vbLf) > 0 Then VarDeclaration = -4 ' Is array
End If

End Function
[/sourcecode]

Is VarType/TypeName replacement functions

So we have the VarType and TypeName functions already implemented in VBA, but, they require variables as the feeder, no considering expressions.

How can we determine if a value is an Integer a Byte or a Long?, a Single or a Double?

Here are some functions that can help to filter the type of variables by their values:

Public Function IsDouble(ByVal value As Variant) As Boolean
If IsNumeric(value) Then IsDouble = Not IsLong(value)
End Function

Public Function IsSingle(ByVal value As Variant) As Boolean
IsSingle = IsDouble(value) And (1.401298E-45 <= VBA.Abs(value) Or VBA.Abs(value) <= 3.402823E+38)
End Function

Public Function IsLong(ByVal value As Variant) As Boolean
If IsNumeric(value) Then IsLong = (VBA.CLng(value) = VBA.Val(value))
End Function

Public Function IsInteger(ByVal value As Variant) As Boolean
IsInteger = (IsLong(value) And VBA.Abs(value) <= 32768)
End Function

Public Function IsByte(ByVal value As Variant) As Boolean
IsByte = (IsLong(value) And VBA.Abs(value) <= 255)
End Function

Public Function IsString(ByVal value As Variant) As Boolean
IsString = (VarType(value) = vbString)
End Function

Public Function IsBoolean(ByVal value As Variant) As Boolean
Dim strTrueLocal As String: strTrueLocal = VBA.CStr(True)
Dim strFalseLocal As String: strFalseLocal = VBA.CStr(False)
IsBoolean = IsString(value) And (VBA.UCase$(value) = "TRUE" _
Or VBA.UCase$(value) = strTrueLocal _
Or VBA.UCase$(value) = "FALSE" _
Or VBA.UCase$(value) = strFalseLocal)
End Function
[/sourcecode]