ASHIS
1/19/2015 - 5:31 PM

USEFUL MACRO: [20th Jan, 2015]

USEFUL MACRO: [20th Jan, 2015]

SectionCONCATENATE.vbs
content_copyfile_download
Private Sub SectionCONCATENATE()
Dim nROWS As Long, nCOLM As Long, c As Long
    nROWS = Selection.Rows.Count
    nCOLM = Selection.Columns.Count

'Vertical Data Set: When there are More than 2 No. of ROWS
    If 1 = nCOLM And 2 < nROWS Then
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=RC[-1]"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",RC[-1])"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(-1, -1).Select
    
        Selection.Resize(nROWS, nCOLM).Select
        ActiveCell.Offset(nROWS - 1, 1).Select
    
        Range(Selection, Selection.End(xlUp)).Select
        Selection.FillDown
    
        ActiveCell.Offset(nROWS - 2, nCOLM - 1).Select
    
        Selection.Copy

'Vertical Data Set: When there are 2 No. of ROWS!
    ElseIf 1 = nCOLM And 2 = nROWS Then
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=RC[-1]"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",RC[-1])"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",""'"",RC[-1],""'"")"
        
        ActiveCell.Select
        Selection.Copy

'Horizontal Data Set: When there are More than 2 No. of ROWS
    ElseIf 1 = nROWS And 2 < nCOLM Then
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=R[-1]C"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(-1, -1).Select
    
        Selection.Resize(nROWS, nCOLM).Select
        ActiveCell.Offset(1, nCOLM - 1).Select
    
        Range(Selection, Selection.End(xlToLeft)).Select
        ActiveCell.Select
        
            For c = 1 To nCOLM - 2
                ActiveCell.Offset(0, 1).Select
                'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
                ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
            Next c
        Selection.Copy
        
'Horizontal Data Set: When there are 2 No. of ROWS!
    ElseIf 1 = nROWS And 2 = nCOLM Then
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=R[-1]C"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
        
        ActiveCell.Select
        Selection.Copy
    Else
        MsgBox ("Please select either more than 1 row or more than 1 column of data!")
    
    End If
End Sub
INCEPTION.vbs
content_copyfile_download
Private Sub auto_open()
    Run ("DelUMContextMenu")    'Calls the function 'DelUMContextMenu' which delete the context menu item 'USEFUL MACROS' if already there to avoide any possible duplication!
    Run ("UMContextMenu")   'Calls the function 'UMContextMenu' which builds a new context menu item as 'USEFUL MACROS'!
End Sub


Private Sub auto_close()
    Run ("DelUMContextMenu")    'Calls the function 'DelUMContextMenu' which delete the context menu of already there to avoide possible duplication!
    Run ("ResUMContextMenu")    'Calls the function 'ResUMContextMenu' which reset the context menu to MS Excel's default!
End Sub
ContextMENU.vbs
content_copyfile_download
Private Sub UMContextMenu()
    Dim ContextMENU As CommandBar
    Dim MySubMenu As CommandBarControl

    'Delete the controls first to avoid duplicates
    Call DelUMContextMenu

    'Set ContextMenu to the Cell menu
    Set ContextMENU = Application.CommandBars("Cell")
    
    'Add custom menu with three buttons
    Set MySubMenu = ContextMENU.Controls.Add(Type:=msoControlPopup, before:=1)

    With MySubMenu
        .Caption = "USEFUL MACROS"
        .Tag = "UsefulMacro"
        .BeginGroup = True
        
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "OpenCalendar"
            .FaceId = 8
            .Caption = "FILL-DATE"
        End With
        
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "SplitROWS"
            .FaceId = 295
            .Caption = "SPLIT-ROWS"
        End With
                        
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "TickCLEANER"
            .FaceId = 292
            .Caption = "TICK-CLEANER"
        End With
        
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "CleanPhoneNo"
            .FaceId = 250
            .Caption = "CLEAN PHONE No"
        End With

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "SectionCONCATENATE"
            .FaceId = 382
            .Caption = "CONCATENATE"
        End With

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "SingleQuotesCONCATENATE"
            .FaceId = 382
            .Caption = "'CONCATENATE'"
        End With
        

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "SquareBracketCONCATENATE"
            .FaceId = 382
            .Caption = "[CONCATENATE]"
        End With

        
        'With .Controls.Add(Type:=msoControlButton)
            '.OnAction = "'" & ThisWorkbook.Name & "'!" & "MergeSHEETS"
            '.FaceId = 159
            '.Caption = "MERGE-SHEETS"
        'End With
                
        'With .Controls.Add(Type:=msoControlButton)
            '.OnAction = "'" & ThisWorkbook.Name & "'!" & "RHISTORY"
            '.FaceId = 250
            '.Caption = "RHISTORY-FORMAT"
        'End With

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "SUPPORT"
            .FaceId = 49
            .Caption = "SUPPORT!"
        End With
        
        
    End With

    'Add seperator to the Cell menu
    'ContextMENU.Controls(4).BeginGroup = True
End Sub



Private Sub DelUMContextMenu()  'Delete the context menu of already there!
    Dim ctrl As CommandBarControl
     'go thru all the cell commandbar controls and delete our menu item
    For Each ctrl In Application.CommandBars("Cell").Controls
        If ctrl.Caption = "USEFUL MACROS" Then ctrl.Delete
    Next
End Sub


Private Sub ResUMContextMenu()  'Reset the context menu to MS Excel's default!
    Application.CommandBars("Cell").Reset
End Sub
ARCHIVE.vbs
content_copyfile_download
Option Explicit


Private Sub OpenCalendar()
   UfCalendar.Show
End Sub


Private Sub SUPPORT()   'Opens the Support webpage when the support contect menu is clicked.
    ActiveWorkbook.FollowHyperlink Address:="http://ashiskumar.wordpress.com/visual-basic/useful-macros/"
End Sub

Private Sub SplitROWS()
Dim vROW As Long, fROW As Long, sSET As Long
    
On Error GoTo GetOut
    vROW = InputBox(Prompt:="Please enter the number of rows that the worksheet is to be splitted with.", Title:="Split Workbook By?") + 1
    fROW = vROW
    sSET = 1
        Do Until Len(Cells(vROW, 1)) = 0
            Rows(vROW).Insert Shift:=xlDown
            vROW = vROW + fROW
            sSET = sSET + 1
        Loop
    MsgBox ("The worksheet has been splitted into " & sSET & " different sets of rows of data.")
GetOut:
End Sub


Private Sub SectionCONCATENATE()
Dim nROWS As Long, nCOLM As Long, c As Long
    nROWS = Selection.Rows.Count
    nCOLM = Selection.Columns.Count

'Vertical Data Set: When there are More than 2 No. of ROWS
    If 1 = nCOLM And 2 < nROWS Then
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "=RC[-1]"
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",RC[-1])"
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(-1, -1).Select
    
        Selection.Resize(nROWS, nCOLM).Select
        ActiveCell.Offset(nROWS - 1, 1).Select
    
        Range(Selection, Selection.End(xlUp)).Select
        Selection.FillDown
    
        ActiveCell.Offset(nROWS - 2, nCOLM - 1).Select
    
        Selection.Copy

'Vertical Data Set: When there are 2 No. of ROWS!
    ElseIf 1 = nCOLM And 2 = nROWS Then
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "=RC[-1]"
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",RC[-1])"
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",""'"",RC[-1],""'"")"
        
        ActiveCell.Select
        Selection.Copy

'Horizontal Data Set: When there are More than 2 No. of ROWS
    ElseIf 1 = nROWS And 2 < nCOLM Then
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = "=R[-1]C"
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(-1, -1).Select
    
        Selection.Resize(nROWS, nCOLM).Select
        ActiveCell.Offset(1, nCOLM - 1).Select
    
        Range(Selection, Selection.End(xlToLeft)).Select
        ActiveCell.Select
        
            For c = 1 To nCOLM - 2
                ActiveCell.Offset(0, 1).Select
                ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
                'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
            Next c
        Selection.Copy
        
'Horizontal Data Set: When there are 2 No. of ROWS!
    ElseIf 1 = nROWS And 2 = nCOLM Then
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = "=R[-1]C"
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
        
        ActiveCell.Select
        Selection.Copy
    Else
        MsgBox ("Please select either more than 1 row or more than 1 column of data!")
    
    End If
End Sub




Private Sub SingleQuotesCONCATENATE()
Dim nROWS As Long, nCOLM As Long, c As Long
    nROWS = Selection.Rows.Count
    nCOLM = Selection.Columns.Count

'Vertical Data Set: When there are More than 2 No. of ROWS
    If 1 = nCOLM And 2 < nROWS Then
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=RC[-1]"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",RC[-1])"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(-1, -1).Select
    
        Selection.Resize(nROWS, nCOLM).Select
        ActiveCell.Offset(nROWS - 1, 1).Select
    
        Range(Selection, Selection.End(xlUp)).Select
        Selection.FillDown
    
        ActiveCell.Offset(nROWS - 2, nCOLM - 1).Select
    
        Selection.Copy

'Vertical Data Set: When there are 2 No. of ROWS!
    ElseIf 1 = nCOLM And 2 = nROWS Then
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=RC[-1]"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",RC[-1],""'"")"
        
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",RC[-1])"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",""'"",RC[-1],""'"")"
        
        ActiveCell.Select
        Selection.Copy

'Horizontal Data Set: When there are More than 2 No. of ROWS
    ElseIf 1 = nROWS And 2 < nCOLM Then
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=R[-1]C"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(-1, -1).Select
    
        Selection.Resize(nROWS, nCOLM).Select
        ActiveCell.Offset(1, nCOLM - 1).Select
    
        Range(Selection, Selection.End(xlToLeft)).Select
        ActiveCell.Select
        
            For c = 1 To nCOLM - 2
                ActiveCell.Offset(0, 1).Select
                'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
                ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
            Next c
        Selection.Copy
        
'Horizontal Data Set: When there are 2 No. of ROWS!
    ElseIf 1 = nROWS And 2 = nCOLM Then
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=R[-1]C"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""'"",R[-1]C,""'"")"
        
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""'"",R[-1]C,""'"")"
        
        ActiveCell.Select
        Selection.Copy
    Else
        MsgBox ("Please select either more than 1 row or more than 1 column of data!")
    
    End If
End Sub

Private Sub SquareBracketCONCATENATE()
Dim nROWS As Long, nCOLM As Long, c As Long
    nROWS = Selection.Rows.Count
    nCOLM = Selection.Columns.Count

'Vertical Data Set: When there are More than 2 No. of ROWS
    If 1 = nCOLM And 2 < nROWS Then
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=RC[-1]"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""["",RC[-1],""]"")"
        
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",RC[-1])"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",""["",RC[-1],""]"")"
        
        ActiveCell.Offset(-1, -1).Select
    
        Selection.Resize(nROWS, nCOLM).Select
        ActiveCell.Offset(nROWS - 1, 1).Select
    
        Range(Selection, Selection.End(xlUp)).Select
        Selection.FillDown
    
        ActiveCell.Offset(nROWS - 2, nCOLM - 1).Select
    
        Selection.Copy

'Vertical Data Set: When there are 2 No. of ROWS!
    ElseIf 1 = nCOLM And 2 = nROWS Then
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=RC[-1]"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""["",RC[-1],""]"")"
        
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",RC[-1])"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-1]C,"","",""["",RC[-1],""]"")"
        
        ActiveCell.Select
        Selection.Copy

'Horizontal Data Set: When there are More than 2 No. of ROWS
    ElseIf 1 = nROWS And 2 < nCOLM Then
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=R[-1]C"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""["",R[-1]C,""]"")"
        
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""["",R[-1]C,""]"")"
        
        ActiveCell.Offset(-1, -1).Select
    
        Selection.Resize(nROWS, nCOLM).Select
        ActiveCell.Offset(1, nCOLM - 1).Select
    
        Range(Selection, Selection.End(xlToLeft)).Select
        ActiveCell.Select
        
            For c = 1 To nCOLM - 2
                ActiveCell.Offset(0, 1).Select
                'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
                ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""["",R[-1]C,""]"")"
            Next c
        Selection.Copy
        
'Horizontal Data Set: When there are 2 No. of ROWS!
    ElseIf 1 = nROWS And 2 = nCOLM Then
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.FormulaR1C1 = "=R[-1]C"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(""["",R[-1]C,""]"")"
        
        ActiveCell.Offset(0, 1).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",R[-1]C)"
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",""["",R[-1]C,""]"")"
        
        ActiveCell.Select
        Selection.Copy
    Else
        MsgBox ("Please select either more than 1 row or more than 1 column of data!")
    
    End If
End Sub



Private Sub TickCLEANER()
Dim ColNO As Integer, rDEL As Long, sTIME As Date
On Error Resume Next
ColNO = InputBox("Please enter the column number to check for blank cell or cell with '0' value." & vbCrLf & vbCrLf & "Rows matching with the criteria will be deleted!", "Enter Column No. for Check & Row Delete...")
    If 0 = ColNO Then Exit Sub
    ThisWorkbook.ActiveSheet.Activate
    ActiveSheet.Cells(2, ColNO).Select
    sTIME = Now()
        Do While ActiveCell.Offset(0, ColNO - ((ColNO * 2) - 1)).Value <> ""
            If ActiveCell.Value = 0 Or ActiveCell.Value = "" Then
                Selection.EntireRow.Delete
                rDEL = rDEL + 1
            Else: ActiveCell.Offset(1, 0).Select
            End If
        Loop
    MsgBox ("Deleted " & rDEL & " rows of data in " & Format(Now() - sTIME, "HH:MM:SS") & " seconds!")
    End Sub

Private Sub TickNEATER()
Dim ColNO As Integer, RowNO As Long, rDEL As Long, sTIME As Date
RowNO = 2
ColNO = InputBox("Please enter the column number to check for blank cell or cell with '0' value whose row is to be deleted!", "Enter the column for checking...")
    If 0 = ColNO Then Exit Sub
    ThisWorkbook.ActiveSheet.Activate
    ActiveSheet.Cells(RowNO, ColNO).Select
    sTIME = Now()
        Do While ActiveSheet.Cells(RowNO, ColNO - (ColNO - 1)).Value <> ""
            If ActiveCell.Value <> 0 Or ActiveCell.Value <> "" Then
                RowNO = RowNO + 1
                ActiveSheet.Cells(RowNO, ColNO).Select
            Else
                Selection.EntireRow.Delete
                rDEL = rDEL + 1
            End If
        Loop
    MsgBox ("Deleted " & rDEL & " rows of data in " & Format(Now() - sTIME, "HH:MM:SS") & " seconds!")
End Sub
MsgBox ("Deleted " & rDEL & " rows of data in " & Format(Now() - sTIME, "HH:MM:SS") & " seconds!")
End Sub

Private Sub CleanPhoneNo()
Dim Remove(), nROWS As Integer, x As Integer, i As Variant

On Error Resume Next
nROWS = Selection.Rows.Count
ThisWorkbook.ActiveSheet.Activate
ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
Remove() = Array("~", "`", "!", "@", "#", "$", "%", "^", "&", "(", ")", "-", "_", "=", "{", "}", "[", "]", "\", "|", ";", ":", "'", ",", "<", ">", "/", " ")

    For x = 1 To nROWS
        ActiveCell.Value = "'" & ActiveCell.Offset(0, -1).Value
        
        For Each i In Remove()
            ActiveCell.Replace What:=i, Replacement:="", MatchCase:=True
        Next i
        
        If Left(ActiveCell.Value, 1) = "+" Then ActiveCell.Replace What:=Left(ActiveCell.Value, 3), Replacement:="", MatchCase:=True
        If Left(ActiveCell.Value, 1) = "0" Then ActiveCell.Replace What:=Left(ActiveCell.Value, 1), Replacement:="", MatchCase:=True
        If Left(ActiveCell.Value, 1) = "0" Then ActiveCell.Replace What:=Left(ActiveCell.Value, 1), Replacement:="", MatchCase:=True

        ActiveCell.Value = "'" & ActiveCell.Offset(0, -2).Value & ActiveCell.Value

        ActiveCell.Offset(1, 0).Select
    Next x
    
End Sub