UAE Gratuity Calculator

 =IF(@Nationality="United Arab Emirates",0,IF(@Service_Days<365,0,IF(@Service_Days<1095,@Service_Days/365*@Basic_Salary/30*7,IF(@Service_Days<1825,@Service_Days/365*@Basic_Salary/30*21,(105*@Basic_Salary/30)+(@Service_Days-1825)/365*@Basic_Salary/30*30))))

ShadowCopy

View shadow copy of system drives

https://www.dropbox.com/s/iet21ewbzdccdgm/ShadowCopy.zip?dl=0

Map Network Drive Script

On Error Resume Next

'Delete all Netwrok Drives 
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set oDrives = WshNetwork.EnumNetworkDrives
For i = 0 to oDrives.Count - 1 Step 2
WshNetwork.RemoveNetworkDrive oDrives.Item(i),true,true
Next

dim objNetwork, strDrive, objShell, objUNC
dim strRemotePath, strDriveLetter, strNewName
set wshNetwork = createObject("Wscript.Network")
strUsername = wshNetwork.UserName
call mapdrive("X:","\\Server\share1","Share1")
call mapdrive("Y:","\\Server\share1","Share2")

function mapdrive(strDriveLetter,strRemotePath,strNewName)

'Map the network drive
set objNetwork = createObject("WScript.Network") 
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath 
   
'Rename the Mapped Drive
set objShell = createObject("Shell.Application")
objShell.NameSpace(strDriveLetter).Self.name = strNewName
end function 

Visio 2016 Activation

@echo off
title Activate Microsoft Visio 2016 ALL versions for FREE!&cls&echo ============================================================================&echo #Project: Activating Microsoft software products for FREE without software&echo ============================================================================&echo.&echo #Supported products:&echo - Microsoft Visio Standard 2016&echo - Microsoft Visio Professional Plus 2016&echo.&echo.&(if exist "%ProgramFiles%\Microsoft Office\Office16\ospp.vbs" cd /d "%ProgramFiles%\Microsoft Office\Office16")&(if exist "%ProgramFiles(x86)%\Microsoft Office\Office16\ospp.vbs" cd /d "%ProgramFiles(x86)%\Microsoft Office\Office16")&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\VisioProVL_KMS_Client-ppd.xrm-ms"  >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\VisioProVL_KMS_Client-ul-oob.xrm-ms" >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\VisioProVL_KMS_Client-ul.xrm-ms" >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\client-issuance-bridge-office.xrm-ms" >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\client-issuance-root.xrm-ms" >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\client-issuance-root-bridge-test.xrm-ms" >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\client-issuance-stil.xrm-ms" >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\client-issuance-ul.xrm-ms" >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\client-issuance-ul-oob.xrm-ms" >nul&cscript //nologo ospp.vbs /inslic:"..\root\Licenses16\pkeyconfig-office.xrm-ms" >nul&echo.&echo ============================================================================&echo Activating your Visio...&cscript //nologo slmgr.vbs /ckms >nul&cscript //nologo ospp.vbs /setprt:1688 >nul&cscript //nologo ospp.vbs /unpkey:W8GF4 >nul&cscript //nologo ospp.vbs /unpkey:RJRJK >nul&cscript //nologo ospp.vbs /inpkey:PD3PC-RHNGV-FXJ29-8JK7D-RJRJK >nul&set i=1
:server
if %i%==1 set KMS=kms7.MSGuides.com
if %i%==2 set KMS=kms8.MSGuides.com
if %i%==3 set KMS=kms9.MSGuides.com
if %i%==4 goto notsupported
cscript //nologo ospp.vbs /sethst:%KMS% >nul&echo ============================================================================&echo.&echo.
cscript //nologo ospp.vbs /act | find /i "successful" && (echo.&echo ============================================================================&echo.&echo #My official blog: MSGuides.com&echo.&echo #How it works: bit.ly/kms-server&echo.&echo #Please feel free to contact me at msguides.com@gmail.com if you have any questions or concerns.&echo.&echo #Please consider supporting this project: donate.msguides.com&echo #Your support is helping me keep my servers running everyday!&echo.&echo ============================================================================&choice /n /c YN /m "Would you like to visit my blog [Y,N]?" & if errorlevel 2 exit) || (echo The connection to my KMS server failed! Trying to connect to another one... & echo Please wait... & echo. & echo. & set /a i+=1 & goto server)
explorer "http://MSGuides.com"&goto halt
:notsupported
echo.&echo ============================================================================&echo Sorry! Your version is not supported.&echo Please try installing the latest version here: bit.ly/downloadmsp
:halt
pause >nul

Excel VBA to Export Sheets to Seperate Files

Export Sheets to Files
======================================
Option Explicit
Dim MainWorkBook As Workbook
Dim NewWorkBook As Workbook
Sub ExportWorksheet()
Dim Pointer As Long
Dim Filepath As String
Dim strFolder As String
Filepath = ActiveWorkbook.Path

Set MainWorkBook = ActiveWorkbook
'''''''''''''''''''''''''Display number of worksheets
'Range("E2").Value = MainWorkBook.Sheets.Count
Application.ScreenUpdating = False   'enhance the performance
For Pointer = 2 To MainWorkBook.Sheets.Count
    Set NewWorkBook = Workbooks.Add
    MainWorkBook.Sheets(Pointer).Copy After:=NewWorkBook.Sheets(1)
    Application.DisplayAlerts = False
    NewWorkBook.Sheets(1).Delete
    Application.DisplayAlerts = True
    ''''''''''''''''''''''Save new work sheets
   
    strFolder = Filepath & "\" & "ExportedSheets"
 '''''''''''''''''''''''''Create dierctory if not present

 If Dir(strFolder, vbDirectory) = "" Then MkDir strFolder
   
    With NewWorkBook
       
        '.SaveAs Filename:=Filepath & "\" & "Sheets" & "\" & MainWorkBook.Sheets(Pointer).Name & ".xlsx"
        .SaveAs Filename:=strFolder & "\" & MainWorkBook.Sheets(Pointer).Name & ".xlsx"
     
    End With
    NewWorkBook.Close SaveChanges:=True
Next Pointer
Application.ScreenUpdating = True
'''''''''''''''Optional Display Message
'Range("D5").Value = "Export Completed"
'MsgBox "Done"
Shell "explorer.exe " & strFolder, vbNormalFocus
End Sub
------------------------------------------------

Excel VBA to Split Data into Multiple Sheets

------------------------
Sub Splitdatabycol()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Code by Ali Navas", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Code by Ali Navas", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move After:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
Sheets(myarr(i) & "").Paste Destination:=Sheets(myarr(i) & "").Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub
---------------------------------------------------------------

Download Music from Apple

As you know that you need subscription to Apple Music to listen to songs. They are giving three months free to try out. This three months you can utilize the maximum by downloading music offline. Though it allows you to download music, you can’t play this in any other device and when your subscription ends. Becasuse it has DRM and in m4p format which will play only in Apple devices. So we need those songs offline in mp3 or m4a format without DRM.   As of now there is no straight way to download music from Apple. Below are some tricky steps to download the same.
1. Obviously you need an idevice(Iphone, IPad, IPod) and iTunes.
2. You need DVD fab software (DRM removal)which can be downloaded from here
3. Sign into iTunes and subscribe for Apple Music free for three months
4. Open iTunes and search for your favorite music/playlist
5. Click the plus sign to add to playlist and then cloud icon to download the song.
6. Now you have the song offline, but can be played only in idevices
7. Now close iTunes
8. Open DVDfab DRM removal for Apple
9. Click add from iTunes(before you do this you need to share your xml library in iTunes settings)
10. Now click start to convert the songs
11.Hola!! You have the songs offline, in the usual format (m4a)which can be played offline in any device

Fill Blank Cells in Excel

Here is a video on how to fill the blank cells in Excel

Excel Formulae - Calculate Age

=INT(YEARFRAC("Date of Birth",TODAY())

Download Old version of APPS for iphone

http://www.idownloadblog.com/2015/12/25/how-to-download-older-versions-of-ios-apps/