Function Code_Combination()
    Dim mval As String
    Dim Myval As String
    Dim cadd() As Range
    Dim mcell() As Range
    Dim mrng As Range
    Dim i As Long
    Dim e As Long
    Dim clm As Long
    Dim n As Long
    Dim msheet As String
    e = 1
    On Error Resume Next
    Set mrng = Application.InputBox(Prompt:="Please select begning cell.", Title:="www.excelmacroclasses.com", Type:=8)
    If Err.Number <> 0 Then Exit Function
    If mrng.Address = "" Then Exit Function
    On Error GoTo 0
    appstart
    msheet = ActiveSheet.Name
    Sheets("OUTPUT_SHEET").Delete
    Sheets.Add.Name = "OUTPUT_SHEET"
    Sheets("OUTPUT_SHEET").Range("A1").Value = "Sr No#"
    Sheets("OUTPUT_SHEET").Range("B1").Value = "Combination"
    Sheets(msheet).Activate
    mrng.Select
    i = 0
    Do
        DoEvents
        i = i + 1
    Loop Until IsEmpty(mrng.Offset(0, i)) = True
    ReDim cadd(i)
    ReDim mcell(i)
    Dim tc As Integer
    tc = i - 1
    i = 0
    Do
        DoEvents
        Set cadd(i) = mrng.Offset(0, i)
        Set mcell(i) = cadd(i)
        i = i + 1
    Loop Until IsEmpty(mrng.Offset(0, i)) = True
    Range("I:I").ClearContents
    clm = 1
    For n = tc To 0 Step -1
        DoEvents
        Do
            DoEvents
            Do
                DoEvents
step1:
                For i = 0 To tc
                    DoEvents
                    mval = mcell(i).Value
                    Myval = Myval & "-" & mval
                    If IsEmpty(mcell(i)) = True Then
                        Set mcell(i) = cadd(i)
                        Set mcell(i - 1) = mcell(i - 1).Offset(1, 0)
                        Myval = ""
                        GoTo step1
                    End If
                Next
                i = tc
                Set mcell(tc) = mcell(tc).Offset(1, 0)
                Sheets("OUTPUT_SHEET").Range("A1").Offset(e, 0).Value = e
                Sheets("OUTPUT_SHEET").Range("A1").Offset(e, 1).Value = Myval
                Application.StatusBar = e
                e = e + 1
                Myval = ""
            Loop Until IsEmpty(mcell(tc)) = True
            For i = 0 To tc
                DoEvents
                If IsEmpty(mcell(i)) = True Then
                    If IsEmpty(mcell(0)) = True Then GoTo ends
                    Set mcell(i) = cadd(i)
                    Set mcell(i - 1) = mcell(i - 1).Offset(1, 0)
                    If IsEmpty(mcell(i - 1)) = True Then
                        On Error GoTo ends
                        Set mcell(i - 1) = cadd(i - 1)
                        Set mcell(i - 2) = mcell(i - 2).Offset(1, 0)
                    End If
                End If
            Next
            clm = clm + 1
        Loop Until clm = tc
    Next
ends:
    For i = 0 To tc
        DoEvents
        Set cadd(i) = Nothing
        Set mcell(i) = Nothing
    Next
    MsgBox "Finish", vbInformation
    append
End Function