Excel VBA Table Tools / DB facilities

ThisWorkbook.cls

-----------------------------------------

VERSION 1.0 CLASS

BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ThisWorkbook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Const gs_toolbar_1 As String = "my_toolbar_db_1"
Private Const gs_toolbar_2 As String = "my_toolbar_db_2"
Private Const gs_toolbar_3 As String = "my_toolbar_db_3"
Private Const gs_toolbar_4 As String = "my_toolbar_db_4"


Private Sub Workbook_Activate()
    Dim lcb_commdbar As CommandBar
    
    On Error GoTo error_exit
    
    Set lcb_commdbar = Application.CommandBars(gs_toolbar_1)
    lcb_commdbar.Visible = True
    
    Set lcb_commdbar = Application.CommandBars(gs_toolbar_2)
    lcb_commdbar.Visible = True
    
    Set lcb_commdbar = Application.CommandBars(gs_toolbar_3)
    lcb_commdbar.Visible = True
    
    Set lcb_commdbar = Application.CommandBars(gs_toolbar_4)
    lcb_commdbar.Visible = True
    
    
error_exit:
    Set lcb_commdbar = Nothing
End Sub

Private Sub Workbook_Deactivate()
    Dim lcb_commdbar As CommandBar
    
    On Error GoTo error_exit
    
    Set lcb_commdbar = Application.CommandBars(gs_toolbar_1)
    lcb_commdbar.Visible = False
    
    Set lcb_commdbar = Application.CommandBars(gs_toolbar_2)
    lcb_commdbar.Visible = False
    
    Set lcb_commdbar = Application.CommandBars(gs_toolbar_3)
    lcb_commdbar.Visible = False
    
    Set lcb_commdbar = Application.CommandBars(gs_toolbar_4)
    lcb_commdbar.Visible = False
error_exit:
    
    Set lcb_commdbar = Nothing
    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    
    Call sub_RemoveToolBar(gs_toolbar_1)
    Call sub_RemoveToolBar(gs_toolbar_2)
    Call sub_RemoveToolBar(gs_toolbar_3)
    Call sub_RemoveToolBar(gs_toolbar_4)
      
  '  Call sub_remove_all_bars
    Call f_disconnect_db
    
End Sub


Private Sub Workbook_Open()
    Application.OnKey "+^d", "sub_AutoFill"
    
    gs_saved_path = ThisWorkbook.Path
    
    gs_freeze_screen = "TOP"
    
    'gl_MaxRow_ofExcel = ThisWorkbook.Sheets(1).Columns(1).Rows.Count
    'gl_MaxCol_ofExcel = ThisWorkbook.Sheets(1).Rows(1).Columns.Count
   
    Dim ls_toolbar As String
    Call sub_remove_all_bars
    
    '============================================================================================
    ls_toolbar = gs_toolbar_1
    
    Call sub_RemoveToolBar(ls_toolbar)
    Call sub_add_new_bar(ls_toolbar)
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Create Table Sheet", _
                    as_on_action:="sub_create_table_sheet", ai_face_id:=300, _
                    as_tip_text:="Create a new sheet for table you selected")
                    
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Reset Link/Condi Format", _
                    as_on_action:="sub_RefreshLink_n_ResetCondFormat", ai_face_id:=53, _
                    as_tip_text:="Reset Link/Condi Format")
                    
'    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Refresh link for all", _
'                    as_on_action:="sub_RefreshLink_For_AllSheet", ai_face_id:=53, _
'                    as_tip_text:="Refresh link for all sheets")
'
'    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Refresh Conditional Format", _
'                    as_on_action:="sub_refresh_cond_format", ai_face_id:=639, _
'                    as_tip_text:="Refresh Conditional Format")
                    
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Merge all cells", _
                    as_on_action:="sub_merge_all_cells", ai_face_id:=402, _
                    as_tip_text:="Merge all cells for the table definition file")
                    
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="CreateTableSheet-ForAll", _
                    as_on_action:="sub_create_table_sheet_for_all", ai_face_id:=302, _
                    as_tip_text:="Create all tables' sheet")

'    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="", _
'                    as_on_action:="'sub_RemoveToolBar """ & gs_toolbar_1 & """'", ai_face_id:=722, _
'                    as_tip_text:="Exit this toolbar")
    '============================================================================================
    
    
    '============================================================================================
    ls_toolbar = gs_toolbar_2
    
    Call sub_RemoveToolBar(ls_toolbar)
    Call sub_add_new_bar(ls_toolbar)
    
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Gen Insert SQL", _
                    as_on_action:="sub_gen_insert_sql", ai_face_id:=301, _
                    as_tip_text:="Generate Insert SQL script")

    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Protect Cell", _
                    as_on_action:="sub_lock_cells", ai_face_id:=308, _
                    as_tip_text:="Lock cells to enable edit")

    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="UnProtect Cell", _
                    as_on_action:="sub_unlock_cells", ai_face_id:=309, _
                    as_tip_text:="Lock cells to enable edit")
                    
                    
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Clear filter", _
                    as_on_action:="sub_clear_filter", ai_face_id:=605, _
                    as_tip_text:="Clear filter")
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Clear filter for all", _
                    as_on_action:="sub_clear_filter_criteria", ai_face_id:=605, _
                    as_tip_text:="Clear filter for all")
                    
'    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="", _
'                    as_on_action:="'sub_RemoveToolBar """ & gs_toolbar_2 & """'", ai_face_id:=722, _
'                    as_tip_text:="Exit this toolbar")
    '============================================================================================
    
    '============================================================================================
    ls_toolbar = gs_toolbar_3
    
    Call sub_RemoveToolBar(ls_toolbar)
    Call sub_add_new_bar(ls_toolbar)
    
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Format data", _
                    as_on_action:="sub_format_data", ai_face_id:=501, _
                    as_tip_text:="Format data")
                    
                    
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="Move to LeftMost", _
                    as_on_action:="sub_move_to_leftmost", ai_face_id:=320, _
                    as_tip_text:="Move to leftmost")
                    
'    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="", _
'                    as_on_action:="'sub_RemoveToolBar """ & gs_toolbar_2 & """'", ai_face_id:=722, _
'                    as_tip_text:="Exit this toolbar")
    '============================================================================================
    
    '============================================================================================
    ls_toolbar = gs_toolbar_4
    
    Call sub_RemoveToolBar(ls_toolbar)
    Call sub_add_new_bar(ls_toolbar)
    Call sub_add_new_button(as_bar_name:=ls_toolbar, as_btn_caption:="RetrieveDataFromDB", _
                    as_on_action:="sub_retrieve_data", ai_face_id:=101, _
                    as_tip_text:="Retrieve DB")
End Sub

Module_Toolbar1.bas

--------------------------------------

Attribute VB_Name = "Module_Toolbar1"
Option Explicit
Public Const gs_summary_sheet = "Summary"
Public Const COL_TABLE_NAME = 2
Public Const COL_COLUMN_NAME = 4
Public Const COL_LINK_IN_SUMRY = 7
Public go_summary_sheet As Worksheet
Public gl_xls_max_row As Long

Option Base 1

Public Sub sub_create_table_sheet()
    Dim ls_new_sheet As String
    Dim ls_link_origin_cont As String
    
    Dim sheet_no As Integer
    Dim sheet_count As Integer
    
    'Dim ls_active_sheet As String
    
    Dim li_tab_1st_row As Long
    Dim li_tab_last_row As Long
    Dim li_sheet_max_row As Long
    
    Dim li_new_sheet_col_no As Integer
    
    Dim li_active_row As Integer
    Dim li_row_no_tmp As Integer
    Dim link_add As String
    Dim ls_summary_sheet As String
    Dim Response As String
    
    If ActiveCell.Row <= 1 Then
        MsgBox "you selected the wrong line!"
        Exit Sub
    End If
    
    li_tab_1st_row = 0
    
    On Error GoTo error_exit
    
    'ls_active_sheet = ActiveSheet.Name
    
    If f_initial_for_tab_link("1,2") < 0 Then
        Exit Sub
    End If
        
    go_summary_sheet.Activate
    
    
    gl_xls_max_row_no = Columns(1).Rows.Count
    
    With go_summary_sheet
    
        li_active_row = 0
        li_active_row = ActiveCell.Cells.Row
                
        ls_new_sheet = .Cells(li_active_row, COL_TABLE_NAME).Value
        
        For li_row_no_tmp = li_active_row To 2 Step -1
            If .Cells(li_row_no_tmp, COL_TABLE_NAME).Value <> .Cells(li_row_no_tmp - 1, COL_TABLE_NAME).Value Then
                li_tab_1st_row = li_row_no_tmp
                Exit For
            End If
        Next
        
        sheet_count = Sheets.Count
        
        For sheet_no = 1 To sheet_count
            If Sheets(sheet_no).Name = ls_new_sheet Then
                MsgBox "Sheet " & ls_new_sheet & " already exist"
                Exit Sub
            End If
        Next
        
        Sheets.Add.Name = ls_new_sheet
        
        ActiveWorkbook.Sheets(ls_new_sheet).Move After:=go_summary_sheet
        
        ls_link_origin_cont = Trim(go_summary_sheet.Cells(li_tab_1st_row, COL_LINK_IN_SUMRY).Value)
        
        If ls_link_origin_cont = "" Or IsNull(ls_link_origin_cont) Then
            ls_link_origin_cont = ls_new_sheet
        End If
                
        With go_summary_sheet.Cells(li_tab_1st_row, COL_LINK_IN_SUMRY)
            go_summary_sheet.Hyperlinks.Add Anchor:=go_summary_sheet.Cells(li_tab_1st_row, COL_LINK_IN_SUMRY), Address:="", _
            SubAddress:="'" & ls_new_sheet & "'" & "!A1", TextToDisplay:=ls_link_origin_cont
        End With
        
        li_new_sheet_col_no = 1
        'li_sheet_max_row = Sheets(ls_active_sheet).Range("B104857").End(xlUp).Row
        'li_sheet_max_row = Sheets(ls_active_sheet).Range("B104857").End(xlUp).Row
        li_sheet_max_row = go_summary_sheet.Cells(gl_xls_max_row_no, COL_TABLE_NAME).End(xlUp).Row
        
        For li_row_no_tmp = li_tab_1st_row To li_sheet_max_row
            With Sheets(ls_new_sheet)
                .Cells(1, li_new_sheet_col_no).Value = go_summary_sheet.Cells(li_row_no_tmp, 4).Value
            End With
            
            li_new_sheet_col_no = li_new_sheet_col_no + 1
            
            If .Cells(li_row_no_tmp, COL_TABLE_NAME).Value <> .Cells(li_row_no_tmp + 1, COL_TABLE_NAME).Value Then
                li_tab_last_row = li_row_no_tmp
                
                Sheets(ls_new_sheet).Hyperlinks.Add Anchor:=Cells(1, 1), Address:="", _
                SubAddress:="'" & gs_summary_sheet & "'" & "!G" & li_tab_1st_row
                
                With ActiveWindow
                    .SplitColumn = 1
                    .SplitRow = 1
                End With
                ActiveWindow.FreezePanes = True
                ActiveWindow.DisplayGridlines = False
                
                Range(Cells(1, 1), Cells(1, li_tab_last_row - li_tab_1st_row + 1)).Select
                               
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                With Selection.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                With Selection.Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent6
                    .TintAndShade = 0.399975585192419
                    .PatternTintAndShade = 0
                End With
                
                Selection.Font.Bold = True
                                            
                Cells.Select
                Cells.EntireColumn.AutoFit
                'Selection.NumberFormat = "@"
                
                Cells(1, 1).Select
                                
                Exit For
            End If
        Next
    End With
    
    Sheets(gs_summary_sheet).Activate
    
error_exit:     Exit Sub
End Sub


Public Sub sub_RefreshLink_n_ResetCondFormat()
'    Dim ls_response As String
'
'    ls_response = MsgBox("This will clear all the conditional format, and reset it," & Chr(13) & _
'                         "Please check if you are openning the correct workbook & sheet ""Summary"" " & Chr(13) & _
'                         "Are you sure ?", _
'                         vbCritical + vbYesNoCancel + vbDefaultButton2, "Be careful")
'    If ls_response <> vbYes Then
'        Exit Sub
'    End If
    
    Call sub_RefreshLink_For_AllSheet
    Call sub_refresh_cond_format
    
End Sub

Sub sub_RefreshLink_For_AllSheet()
    Dim lrng_found As Range
    Dim ls_link_origin_cont As String
    Dim each_sheet As Worksheet
    Dim Response As String
    
    On Error GoTo 0
    
    If f_initial_for_tab_link("1,2") < 0 Then
        Exit Sub
    End If
        
    If ActiveWorkbook.Sheets.Count = 0 Then
        Exit Sub
    End If
        
    If Worksheets.Count = 0 Then
        Exit Sub
    End If

    
    go_summary_sheet.Activate

    'For Each each_sheet In ActiveWorkbook.Sheets
    For Each each_sheet In ActiveWorkbook.Worksheets
        'MsgBox (each_sheet.Name)
        
        If each_sheet.Name <> gs_summary_sheet Then
            Set lrng_found = Sheets(gs_summary_sheet).Range("B:B").Find(what:=each_sheet.Name, LookIn:=xlValues, LookAt:=xlWhole)
        
            If Not lrng_found Is Nothing Then
            
                ls_link_origin_cont = Trim(each_sheet.Cells(1, 1).Value)
                        
                each_sheet.Hyperlinks.Add Anchor:=each_sheet.Cells(1, 1), Address:="", _
                SubAddress:="'" & gs_summary_sheet & "'!" & lrng_found.Address, TextToDisplay:=ls_link_origin_cont
                        
            End If
            
        End If
    Next
End Sub


Sub sub_refresh_cond_format()
 
    On Error GoTo 0
    
    Dim ls_temp As String
    Dim lrng_range As Range
    
    ls_temp = Sheets("Summary").Name
    
    If Trim(ls_temp) = "" Then
        MsgBox ("No sheet ""Summary"", please check!")
        Exit Sub
    End If
    
    Sheets("Summary").Activate
    gl_xls_max_row_no = Range("A:A").Rows.Count
    
    Cells.FormatConditions.Delete
        
    'set grid for all
    Set lrng_range = Sheets("Summary").Range("$A$1:$J$" & gl_xls_