Sub MakeCobmination()
Application.ScreenUpdating = False
Dim t As Double
Dim Digit As Double
Dim SS As Double
Dim j As Double
Combination = InputBox("Enter Digit ")
SS = 2 ^ Combination
If Val(Combination) > 20 Then
MsgBox "you Can give till 20 ", vbInformation
Exit Sub
End If
t = 1
n = 1
lp = 1
j = 1
Cells.ClearContents
For lp = 1 To Combination
For n = 1 To SS / lp * 2
For i = 1 To lp
Cells(j, lp).Value = 0
j = j + 1
Next
For i = 1 To lp
Cells(j, lp).Value = 1
j = j + 1
Next
Cells(j, lp).Select
If ActiveCell.Row >= SS + 1 Then Exit For
Next
j = 1
Next
Range("A" & Range("A65536").End(xlUp).Row + 1).Resize(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.Columns.Count).ClearContents
C = ActiveSheet.UsedRange.Columns.Count
R = ActiveSheet.UsedRange.Rows.Count
For H = 1 To R
For M = 1 To C
st = st & Cells(H, M).Value
Next
Cells(H, C + 1).Value = "'" & st
st = ""
Next
Range("A1").Resize(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count - 1).Columns.Delete
Application.ScreenUpdating = True
End Sub
1 comment:
Doesn't seem to work past 4 digit input. After 4 it starts to double up possible combinations
Post a Comment