CONVERT EXCEL DATA TO JSON

Software Lab Excel To JSON
Description:
This set of VBA codes creates a customized Excel Function that can be used to convert an Excel data Table/List into JSON format. The JSON format can then be used for web purposes as this is in JavaScript format which is the main scripting language for websites.
Code:
Public Function ToJson(DataTable As Range) As String

    Dim Headerrange As Range
    Dim colcount As Long
    Dim i As Long
    Dim c As Long
    Dim textline As String
    Dim Rng As Range
    Dim quote As String
    
    Set Headerrange = Range(DataTable.Rows(1).Address)
    colcount = Headerrange.Columns.Count
    quote = """"
    
    MsgBox "Number of rows = " & DataTable.Rows.Count, vbOKOnly, "Bliss Logic"
    MsgBox "Number of columns = " & colcount, vbOKOnly, "Bliss Logic"
    
    With DataTable
    
        For i = 1 To DataTable.Rows.Count
        
        If i > 1 Then
        
            textline = "{"
    
            For c = 1 To colcount
                
                textline = textline & quote & .Cells(1, c) & quote & ":"
                textline = textline & quote & .Cells(i, c) & quote
                textline = textline & ","
            
            Next c
            
            ToJson = ToJson & Left(textline, Len(textline) - 1) & "},"
        
        End If
        
        Next i
    
            
    End With
    
    ToJson = "[" & Left(ToJson, Len(ToJson) - 1) & "]"
    
    
End Function


Procedures:
  1. Insert a new module (VBA) in your excel file.
  2. Copy and paste the above codes into the module.
  3. Type in a cell “=ToJson(Range)” where Range is your Excel List with Header Columns included.
  4. This is very similar to you using the SUM function in Excel – “=SUM(“A1:A15″)”

GENERATE SEQUENTIAL DATES WITH VBA

Software Lab Generate Sequential Dates
Description:
This set of VBA codes can be used to generate sequential dates. Very useful for getting a list of future sequential dates from a start date. Further use can be applied by applying perhaps weekday filter or specific days on these sequential dates.
Code:
Sub DateLoop()

Dim i As Integer
Dim j As Date
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range



'Set wb = Workbooks("StoredProcedure.xlsm")
Set wb = ActiveWorkbook

'j = Range("E1").Value
j = "2018-01-31"


With wb
    .Activate
    Worksheets("Sheet1").Select
    
    
    If ActiveSheet.FilterMode Then ActiveSheet.AutoFilterMode = False
    
    Columns("A:B").Clear

             
    For i = 1 To 90
    
        Cells(i, 1).Value = j + i
        Cells(i, 2).Value = Format(Cells(i, 1), "dddd")
    
    Next i
    
    Range("A1:B1").Insert
    
    Range("A1").Select
        With Selection
            .Value = "Date"
            .ColumnWidth = 15
        End With
        
    Range("B1").Select
        With Selection
            .Value = "Day"
            .ColumnWidth = 15
        End With

Set rng = ActiveSheet.Range("A1:B31")
    
'Turn on filter if not already turned on
  If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter
      
'Filter Specific Days
  rng.AutoFilter Field:=2, Criteria1:=Array( _
    "Monday", "Tuesday", "Wednesday", "Thursday", "Friday"), Operator:=xlFilterValues
    
End With



End Sub

Procedures:
  1. Insert a new module (VBA) in your excel file.
  2. Copy and paste the above codes into the module.
  3. With the start date, you may update the “j” value directly in the code.

EXCEL VBA TO CLEAR TABLE DATA

Sub TableClearData()

Dim tbl As ListObject
Dim ws As Worksheet
Dim LR As Long


Set ws = Sheets("FrxDump")
Set tbl = Sheets("DataDump").ListObjects("Table2")
LR = ws.Range("A" & Rows.Count).End(xlUp).Row

If tbl.ListRows.Count >= 1 Then
    tbl.DataBodyRange.Delete
End If

ws.Range("A5:F" & LR).Copy Destination:=Sheets("DataDump").Range("A3")



End Sub

EXCEL VBA FOR CONDITIONAL FORMATTING

Software Lab Conditional Format
Description:
This set of VBA codes can be used to format all cells in a range that meet one or multiple criteria. This was particularly useful when you wished to highlight all cells that meet certain condition.
Code:
Sub LoopCF()

    Dim Rng     As Range
    Dim rnArea  As Range
    Dim CRng    As Range
    Dim doc     As String
    Dim ic      As Long
    Dim rnCell  As Range
    
    Set rnArea = Range("C3:J6, C9:J12, C15:J18, C21:J24")
    Set CRng = Range("L40:L53")
    
    rnArea.Interior.ColorIndex = xlNone
    
    For Each cell In CRng
        doc = "*" & cell.Value & "*"
        For Each rnCell In rnArea
            With rnCell
                If .Value <> 0 Then
                    Select Case True
                        Case rnCell Like doc
                        .Interior.Color = 13551615
                    End Select
                    Else
                    ic = xlNone
                End If
            End With
        Next rnCell
    Next cell
       
End Sub

Code:
Sub ConditionalFormatting()


Range("C11").Select

    With Range("C11:C16").FormatConditions.Add( _
        Type:=xlExpression, _
        Formula1:="=C11<=C$4")
        
        .Interior.Color = RGB(198, 239, 206)
        .Font.Color = RGB(0, 97, 0)
    
    End With
End Sub

Sub ClearFormatting()

rspn = MsgBox("To clear all formatting", vbYesNo)
If rspn = vbYes Then Range("C9:Z140").FormatConditions.Delete

End Sub

Procedures:
  1. Insert a new module (VBA) in your excel file.
  2. Copy and paste the above codes into the module.
  3. The CRng variable can be re-defined to house your criteria.
  4. Go to active worksheet where you wish to apply this conditional formatting and run the macro.

EXCEL VBA SPLIT CSV DATA

Sub CsvSplit()
     
    Dim DataItem As Variant
    Dim lngMyOffset As Long
    Dim StartRowNo As Long
    Dim EndRowNo As Long
    Dim StartColumn As String
    Dim rngCell As Range
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    StartRowNo = 5 'Starting row number for the data. Change to suit.
    StartColumn = "A" 'Column containing the data. Change to suit.
     
    Application.ScreenUpdating = False
    
    ws.Select
     
    For Each rngCell In Range(StartColumn & StartRowNo & ":" & StartColumn & Cells(Rows.Count, StartColumn).End(xlUp).Row)
         
        lngMyOffset = 0
         
        For Each DataItem In Split(rngCell.Value, ",")
            If lngMyOffset = 0 Then
                rngCell.Offset(0, 4).Value = DataItem
            ElseIf lngMyOffset = 2 Then
                rngCell.Offset(0, 5).Value = DataItem
            ElseIf ingMyOffset = 0 Then
                rngCell.Offset(0, 7).Value = DataItem
            End If
            lngMyOffset = lngMyOffset + 2
        Next DataItem
         
    Next rngCell
       
    'Rows("1:3").Insert
     
    Application.ScreenUpdating = True
     
    MsgBox "Data split by comma now completed"
     
End Sub

EXCEL VBA WRITE TEXT FILES

How to use Excel VBA to write text files as output

This is a post on a recent trial that I have in terms of converting a set of excel data organized as a list into an output text file. Sometimes this may be need to be done in order to enable migration of excel data into a new system that only reads text files.

Software Lab Excel To CSV
Description:
This set of VBA codes can be used to convert an Excel data Table/List into CSV file. The CSV file format is very useful as it can be used as a platform for migrating data from Excel into various database environments. The flexibility behind this codes is that VBA can be used to manipulate the dataset so that the format can be triggered and maintained with minimal user intervention. This will facilitate the optimization of the CSV file for import packages.
Code:

Sub PrintToTextFile()
    
    
    Dim ws As Worksheet
    Dim FName As String
    Dim FNumber As Integer
    Dim LastRow As Long
    Dim i As Long
    Dim Map As Long
    Dim TextLine As String
    Dim HeaderLine As String
    
    ' Set your worksheet to where the data resides
    Set ws = Sheet6
    ws.Activate
    Range("A1").Select
    
    'Find the last row that contains data
    With ws
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    'Naming your text file
    HeaderLine = ws.Range("H1").Value
    FName = ThisWorkbook.Path & "\" & HeaderLine & "_QboImport.csv"
    
    'Get an unused file number
    FNumber = FreeFile
    
    Open FName For Output As #FNumber
    
    For i = 3 To LastRow
    
        With ws
            
            TextLine = Format(.Cells(i, 1), "dd-mm-yy") & ","
            TextLine = TextLine & .Cells(i, 2) & " | " & .Cells(i, 4) & ","    'Looks at Column 2 & 4 and merges them
            TextLine = TextLine & .Cells(i, 3) * -1  'Looks at Column 3
                    
        End With
                
        Print #FNumber, TextLine
    
    Next i
    
    
    Close #FNumber
       
    MsgBox ("Your Output Text File can be found at " & FName)
    
       
End Sub
Code:
Option Explicit

Sub PrintToTextFile()
    
    
    Dim ws As Worksheet
    Dim FName As String
    Dim FNumber As Integer
    Dim LastRow As Long
    Dim i As Long
    Dim TextLine As String
    Dim HeaderLine As String
    
    ' Set your worksheet to where the data resides
    Set ws = Sheet4
    ws.Activate
    Range("A1").Select
    
    'Find the last row that contains data
    With ws
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    'Naming your text file
    FName = ThisWorkbook.Path & "\TestPrint.txt"
    
    'Get an unused file number
    FNumber = FreeFile
    
    Open FName For Output As #FNumber
    
    HeaderLine = "!STARTTRN" & vbTab
    Print #FNumber, HeaderLine
    Print #FNumber, "Column1" & vbTab & "Column2"
    
    'Loop each line that contains data into the output text file
    For i = 2 To LastRow
    
        With ws
            
            TextLine = .Cells(i, 2) & vbTab     'Looks at Column 2
            TextLine = TextLine & .Cells(i, 3) & vbTab      'Looks at Column 3
            TextLine = TextLine & Format(.Cells(i, 1), "dd-mm-yyyy") & vbTab    'Looks at Column 1
        
        End With
                
        Print #FNumber, TextLine
    
    Next i
    
    HeaderLine = "!STARTTRN" & vbTab
    Print #FNumber, HeaderLine

    
    Close #FNumber
       
    MsgBox ("Your Output Text File can be found at " & FName)
    
       
End Sub

Procedures:
  1. Insert a new module (VBA) in your excel file.
  2. Copy and paste the above codes into the module.
  3. Based on codes above, do take note that your excel range data starts from row 3. Therefore row 2 will be your header columns if you have any.
  4. The above codes are based off a 4 column data as follows: DATE | DESCRIPTION | AMOUNT | DETAIL DESCRIPTION
  5. The codes can be modified to increase or decrease the number of columns and also its order.

EXCEL CHECKLIST BOX WITH VBA

How to create excel checklist box with VBA?

Apply the below VBA codes against a specific excel spreadsheet to get the checklist box to automatically appear before each text/number typed into a cell.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim cell As Range
If Target.Row = 2 Then Exit Sub
If Target.Cells.Count > 1 Then
    For Each cell In Target
        Call AddRemoveChkbx(cell)
    Next cell
Else
    Set cell = Target
    Call AddRemoveChkbx(cell)
End If
Application.ScreenUpdating = True
End Sub



Sub AddRemoveChkbx(cell As Range)
Dim CLeft As Double, CTop As Double, CHeight As Double, CWidth As Double
Dim chkbx As CheckBox
If cell.Value <> "" Then
    With cell.Offset(0, -1)
        CLeft = Cells(.Row, .Column).Left + Cells(.Row, .Column).Width
        CTop = Cells(.Row, .Column).Top
        CHeight = Cells(.Row, .Column).Height
        CWidth = Cells(.Row, .Column).Width
    End With
    ActiveSheet.CheckBoxes.Add(CLeft, CTop, CWidth, CHeight).Select
    With Selection
        .Caption = ""
        .Value = xlOff
    End With
   cell.Offset(1, 0).Select
Else
    For Each chkbx In ActiveSheet.CheckBoxes
        If cell.Top = chkbx.Top Then
            chkbx.Delete
            cell.Font.Strikethrough = False
        End If
    Next
    cell.Offset(1, 0).Select
End If
End Sub

EXCEL TABLES IN DATA VALIDATION

How to use excel tables in data validation drop-down list?

This is a good use of excel tables in data validation drop down list. Excel tables are first found in the Microsoft 2007 version and onwards. Prior to that, excel basically use range.

To reference table headers in a drop down list

=INDIRECT("Table1[#Headers]")

To reference a table column in a drop down list

=INDIRECT("Table1[Column Name]")

To reference row number 3 from table in a drop down list

=INDEX(INDIRECT("Table1"),3,0)

VBA TO TRIGGER STORED PROCEDURES

How to use VBA to trigger stored procedures in MSSQL?

This is a piece of useful VBA codes whereby I can use excel VBA to trigger stored procedures in Microsoft SQL. Excel, at least, present a much more user-friendly interface than MSSQL for users who are not so computer savvy.

The below codes basically looks at a connection that is named as ‘SOH’. This is an active connection into the MSSQL database. The command text is an SQL Command script where I have included a variable defined at excel range A1. This will allow the user to define the parameters before running the SQL command. All of the below codes need to be placed in the VBA module.


Sub RefreshSOH()
Dim ws As Worksheet

Set ws = Sheets("Sheet1")
 
    With ActiveWorkbook.Connections("SOH").OLEDBConnection
        .CommandText = "EXECUTE dbo.sp_GetSOH '" & ws.Range("A1").Value & "'"
    End With
    ActiveWorkbook.Connections("SOH").Refresh
   
End Sub