Friday 12 October 2018

Combine all Sheets into one Master Sheet in Excel Macros

Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet()
'Procedure to Consolidate all sheets in a workbook
On Error GoTo IfError

'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'3. Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> DstSht.Name Then
       '5.1: Find the last row on the 'Consolidate_Data' sheet
       DstRow = fn_LastRow(DstSht) + 1          
       '5.2: Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)
'5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
        If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
            MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
        GoTo IfError
        End If            
'5.4: Copy data to the 'consolidated_data' WorkSheet
 SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)              
    End If
Next
IfError:

'6. Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)
    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow
End Function

'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(ByVal Sht As Worksheet)
    Dim lastCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol
End Function

Merge different excel workbooks into a single workbook into different sheets

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook 
    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True) 
    If (vbBoolean <> VarType(fnameList)) Then 
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            Set wbkCurBook = ActiveWorkbook
            For Each fnameCurFile In fnameList
            countFiles = countFiles + 1
            Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
            For Each wksCurSheet In wbkSrcBook.Sheets
 countSheets = countSheets + 1
 wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
 Next
   wbkSrcBook.Close SaveChanges:=False
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If 
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

Delete Consecutive row in Excel Macros

Sub deleteeveryotherrow()
For x = 1 To 100 Step 1
Rows(x & ":" & x).Select
    Selection.Delete Shift:=xlUp
    Next x
End Sub

Select non-ascii characters more than 255 ascii code in SQL Server

;With cteNumbers as
(
    Select ROW_NUMBER() Over(Order By c1.Unique_ID_Column) as N
    From Your_Table_Name c1
)
Select Distinct Unique_ID_Column,Your_Column
From Your_Table_Name t
Join cteNumbers n ON n <= Len(CAST(Your_Column As NVarchar(MAX)))
Where UNICODE(Substring(Your_Column, n.N, 1)) > 255
OR UNICODE(Substring(Your_Column, n.N, 1)) <> ASCII(Substring(Your_Column, n.N, 1))
 order by 1

Select hidden Spaces which are not supporting by ASCII character in SQL Server.

;WITH cte AS
(
   SELECT 0 AS CharCode
   UNION ALL
   SELECT CharCode + 1 FROM cte WHERE CharCode <31
)
SELECT * FROM
   Your_Table_Name T
     cross join cte
WHERE
   EXISTS (SELECT Unique_ID_Column,Your_Column
        FROM Your_Table_Name Tx
        WHERE Tx.Unique_ID_Column = T.Unique_ID_Column
AND Tx.Your_Column LIKE '%' + CHAR(cte.CharCode) + '%'
and cte.CharCode>0
)