Sub Numbers_Roman_Numbers()
'www.Tricks12345.com
'Created a variable for sheet 2
Dim sh2 As Worksheet
Set sh2 = ThisWorkbook.Sheets("sheet2")
sh2.Activate
'Cleared existing data for sheet 2
sh2.Range("A1").CurrentRegion.Clear
Application.Wait (Now + TimeValue("00:00:02"))
'Created variable which stores the data through Inputbox
Dim Max_Number As Integer
Max_Number = InputBox("Please enter the Number", "www.Tricks12345.com")
'Using For Loop
For i = 1 To Max_Number
'Using Mod function
If i Mod 2 <> o Then
'Activate the cell in first column and assign formatting properties
sh2.Cells(i, 1).Activate
With ActiveCell
.Value = i
.Font.Size = 15
.Font.ColorIndex = 9
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
ElseIf i Mod 2 = o Then
'Activate the cell in Second column and assign formatting properties
sh2.Cells(i, 2).Activate
With ActiveCell
.Value = i
.Font.Size = 15
.Font.ColorIndex = 11
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End If
'Assign the ROMAN number in 3rd Column
sh2.Cells(i, 3).Activate
With ActiveCell
.Formula = "=ROMAN(" & i & ")"
.Font.Size = 15
.Font.ColorIndex = 10
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Next
'Resize the 3rd column based on width or length of data
sh2.Columns("C").AutoFit
Application.Wait (Now + TimeValue("00:00:02"))
'Task completed indication
MsgBox "Hi Numbers Printing Completed"
End Sub