A dialog box to change Columns

[Steved]

Hello from Steved

Is it possible please to change Range("D5500")) to say Range("AA5:AA500"))

I've got different columns so I would like to please a Dailog box to come up
when I press the Icon on my Ribbon to ask what column is reqired, for example
Column B

Sub Test()
Dim myS As String
Dim myC As Range

For Each myC In Intersect(ActiveSheet.UsedRange, Range("D5500"))
myS = myC.Value
myC.NumberFormat = "@"
myC.Value = myS
If Len(myC.Value) < 4 And myC.Value > "" Then
Do Until Len(myC.Value) = 4
myC.Value = "0" & myC.Value
Loop
End If
With myC.Characters(Start:=4, Length:=1).Font
.FontStyle = "Bold"
.Underline = xlUnderlineStyleSingle
.COLOR = 255
End With
Next myC
End Sub

Thankyou.

 

[FSt1]

hi
try adding this after your Dim's...
Dim myR As String
myR = InputBox("Enter a range")

change this line from Range("D5"D500") to Range(myR)
For Each myC In Intersect(ActiveSheet.UsedRange, Range(myR))

regards
FSt1

 

[Dave Peterson]

Option Explicit
Sub Test()
Dim myS As String
Dim myC As Range
Dim myRng As Range
Dim myRngToInspect As Range

Set myRng = Nothing
On Error Resume Next
Set myRng = Application.InputBox(Prompt:="Select a column", _
Type:=8).Cells(1)
On Error GoTo 0

If myRng Is Nothing Then
'user hit cancel
Exit Sub '???
End If

Set myRngToInspect = Intersect(myRng.Parent.UsedRange, _
myRng.EntireColumn, _
myRng.Parent.Range("5:500"))

If myRngToInspect Is Nothing Then
MsgBox "nothing to work on!"
Exit Sub
End If

For Each myC In myRngToInspect.Cells
myC.NumberFormat = "@"

If IsEmpty(myC) Then
'skip it
Else
If IsNumeric(myC.Value) Then
'only the numbers < 10000????
If myC.Value < 10000 Then
myC.Value = Format(myC.Value, "0000")
End If
End If
End If

With myC.Characters(Start:=4, Length:=1).Font
.FontStyle = "Bold"
.Underline = xlUnderlineStyleSingle
.Color = 255
End With
Next myC
End Sub

 

[Steved]

Thankyou very much

Best Wishes for the Season

Steved

 

[FSt1]

your's is a lot better than mine.

Regards
FSt1

 

[Steved]

Thankyou

Best wishes for the Season

Steved

Option Explicit
Sub Test()
Dim myS As String
Dim myC As Range
Dim myRng As Range
Dim myRngToInspect As Range

Set myRng = Nothing
On Error Resume Next
Set myRng = Application.InputBox(Prompt:="Select a column", _
Type:=8).Cells(1)
On Error GoTo 0

If myRng Is Nothing Then
'user hit cancel
Exit Sub '???
End If

Set myRngToInspect = Intersect(myRng.Parent.UsedRange, _
myRng.EntireColumn, _
myRng.Parent.Range("5:500"))

If myRngToInspect Is Nothing Then
MsgBox "nothing to work on!"
Exit Sub
End If

For Each myC In myRngToInspect.Cells
myC.NumberFormat = "@"

If IsEmpty(myC) Then
'skip it
Else
If IsNumeric(myC.Value) Then
'only the numbers < 10000????
If myC.Value < 10000 Then
myC.Value = Format(myC.Value, "0000")
End If
End If
End If

With myC.Characters(Start:=4, Length:=1).Font
.FontStyle = "Bold"
.Underline = xlUnderlineStyleSingle
.Color = 255
End With
Next myC
End Sub

 

[Steved]

Thankyou

Best Wishes for the Season

Steved

Option Explicit
Sub Test()
Dim myS As String
Dim myC As Range
Dim myRng As Range
Dim myRngToInspect As Range

Set myRng = Nothing
On Error Resume Next
Set myRng = Application.InputBox(Prompt:="Select a column", _
Type:=8).Cells(1)
On Error GoTo 0

If myRng Is Nothing Then
'user hit cancel
Exit Sub '???
End If

Set myRngToInspect = Intersect(myRng.Parent.UsedRange, _
myRng.EntireColumn, _
myRng.Parent.Range("5:500"))

If myRngToInspect Is Nothing Then
MsgBox "nothing to work on!"
Exit Sub
End If

For Each myC In myRngToInspect.Cells
myC.NumberFormat = "@"

If IsEmpty(myC) Then
'skip it
Else
If IsNumeric(myC.Value) Then
'only the numbers < 10000????
If myC.Value < 10000 Then
myC.Value = Format(myC.Value, "0000")
End If
End If
End If

With myC.Characters(Start:=4, Length:=1).Font
.FontStyle = "Bold"
.Underline = xlUnderlineStyleSingle
.Color = 255
End With
Next myC
End Sub