Input box to select different ranges in excel workbook by user manually and make them bold

S

sunitarobert

New Member
Joined
Oct 8, 2012
Messages
5
Hi Team,

need help here.. i need to create input box to select ranges in workbook manually. so User should get prompt to select ranges in different worksheets and an second button to add if any additional ranges to be selected. Make bold all the ranges selected once selection gets complete
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
VBA Code: 
Option Explicit

Sub GetRange()
' Get ranges from the user to turn to Bold text. _
  More ranges and on different sheets can be _
  selected at once.
  
    Dim rRB As Range
    Dim vInp, vRanges, vEach, vCls, vRC1, vRC2
    Dim lR As Long
    Dim shtS As Worksheet
    
    vInp = Application.InputBox(prompt:="Select range to change to Bold using mouse." _
                & vbCrLf & vbCrLf & "To add more ranges, type a """ & Application.International(xlListSeparator) _
                & """ then select the" & vbCrLf & "next range. You can also add ranges on " _
                & vbCrLf & "other sheets.", _
            Title:="Select range", _
            Type:=0)
    If StrComp(Left(vInp, 1), "=") Then Exit Sub    'cancelled or invalid
    vInp = Replace(vInp, "=", "")

    If Len(vInp) Then
        vRanges = Split(vInp, ",")
        For lR = 0 To UBound(vRanges, 1)
                vEach = Split(vRanges(lR), "!")
                If UBound(vEach, 1) = 1 Then
                    Set shtS = Sheets(vEach(0))
                Else
                    Set shtS = ActiveSheet
                End If
                vCls = Split(vEach(UBound(vEach, 1)), ":")
                With shtS
                    If UBound(vCls, 1) > 0 Then
                        vRC1 = CellsFromRC(vCls(0))
                        vRC2 = CellsFromRC(vCls(1))
                        Set rRB = .Range(.Cells(vRC1(0), vRC1(1)), .Cells(vRC2(0), vRC2(1)))
                    Else
                        vRC1 = CellsFromRC(vCls(0))
                        Set rRB = .Cells(vRC1(0), vRC1(1))
                    End If
                End With
                Range2Bold rRB
        Next lR
    End If
End Sub

Sub Range2Bold(rRange As Range)
'Turn range to bold

    With rRange
        .Font.Bold = True
    End With
    
End Sub

Function CellsFromRC(sRC) As Long()
'Return row and column number form RC notation

    Dim vS As Variant
    Dim lRC(1) As Long
    
    vS = Split(sRC, "C")
    lRC(0) = CLng(Replace(vS(0), "R", ""))
    lRC(1) = CLng(vS(1))
    CellsFromRC = lRC
End Function
 
Upvote 0
Th
sijpie said:
VBA Code: 
Option Explicit

Sub GetRange()
' Get ranges from the user to turn to Bold text. _
  More ranges and on different sheets can be _
  selected at once.
 
    Dim rRB As Range
    Dim vInp, vRanges, vEach, vCls, vRC1, vRC2
    Dim lR As Long
    Dim shtS As Worksheet
   
    vInp = Application.InputBox(prompt:="Select range to change to Bold using mouse." _
                & vbCrLf & vbCrLf & "To add more ranges, type a """ & Application.International(xlListSeparator) _
                & """ then select the" & vbCrLf & "next range. You can also add ranges on " _
                & vbCrLf & "other sheets.", _
            Title:="Select range", _
            Type:=0)
    If StrComp(Left(vInp, 1), "=") Then Exit Sub    'cancelled or invalid
    vInp = Replace(vInp, "=", "")

    If Len(vInp) Then
        vRanges = Split(vInp, ",")
        For lR = 0 To UBound(vRanges, 1)
                vEach = Split(vRanges(lR), "!")
                If UBound(vEach, 1) = 1 Then
                    Set shtS = Sheets(vEach(0))
                Else
                    Set shtS = ActiveSheet
                End If
                vCls = Split(vEach(UBound(vEach, 1)), ":")
                With shtS
                    If UBound(vCls, 1) > 0 Then
                        vRC1 = CellsFromRC(vCls(0))
                        vRC2 = CellsFromRC(vCls(1))
                        Set rRB = .Range(.Cells(vRC1(0), vRC1(1)), .Cells(vRC2(0), vRC2(1)))
                    Else
                        vRC1 = CellsFromRC(vCls(0))
                        Set rRB = .Cells(vRC1(0), vRC1(1))
                    End If
                End With
                Range2Bold rRB
        Next lR
    End If
End Sub

Sub Range2Bold(rRange As Range)
'Turn range to bold

    With rRange
        .Font.Bold = True
    End With
   
End Sub

Function CellsFromRC(sRC) As Long()
'Return row and column number form RC notation

    Dim vS As Variant
    Dim lRC(1) As Long
   
    vS = Split(sRC, "C")
    lRC(0) = CLng(Replace(vS(0), "R", ""))
    lRC(1) = CLng(vS(1))
    CellsFromRC = lRC
End Function
Click to expand...
Thanks a lot it is working within a worksheet, if more than a worksheet selected then giving error as "run-time error '9' subscript out of range" at this line Set shtS = Sheets(vEach(0)).
 
Upvote 0
Ah, I think I understand what you are doing. The macro works if you select a sheet and then a range on the sheet, and you can repeat this. But it fails if you select several sheets at once and the select a range.

I will see if I can adjust the macro.
 
Upvote 0
VBA Code: 
Option Explicit

Sub GetRange()
' Get ranges from the user to turn to Bold text. _
  More ranges and on different sheets can be _
  selected at once.
  
    Dim vInp, vRanges, vEach, vCls, vSht
    Dim lR As Long, lS1 As Long, lS2 As Long
    Dim shts As Worksheet
    
    vInp = Application.InputBox(prompt:="Select range to change to Bold using mouse." _
                & vbCrLf & vbCrLf & "To add more ranges, type a """ & Application.International(xlListSeparator) _
                & """ then select the" & vbCrLf & "next range. You can also add ranges on " _
                & vbCrLf & "other sheets.", _
            Title:="Select range", _
            Type:=0)
    If StrComp(Left(vInp, 1), "=") Then Exit Sub    'cancelled or invalid
    vInp = Replace(vInp, "=", "")

    If Len(vInp) Then
        vRanges = Split(vInp, ",")
        For lR = 0 To UBound(vRanges, 1)
                vEach = Split(vRanges(lR), "!")
                If UBound(vEach, 1) = 1 Then    'other sheet(s) than activesheet
                    If vEach(0) Like "*:*" Then 'grouped sheets
                        vSht = Split(vEach(0), ":")
                        lS1 = GetShtNr(CStr(vSht(0)))
                        lS2 = GetShtNr(CStr(vSht(1)))
                        For lS1 = lS1 To lS2 Step IIf(lS2 > lS1, 1, -1)
                            Set shts = Worksheets(lS1)
                            SheetRangeToBold shts, vEach(1)
                        Next lS1
                    Else                        'single sheet
                        Set shts = Sheets(vEach(0))
                        SheetRangeToBold shts, vEach(1)
                    End If
                Else                            'no sheet name, so active sheet
                    Set shts = ActiveSheet
                    SheetRangeToBold shts, vEach(UBound(vEach, 1))
                End If
        Next lR
    End If
    'following because sometimes activesheet not displayed correctly
    Set shts = ActiveSheet
    Sheets(Sheets.Count).Activate
    shts.Activate
End Sub

Sub SheetRangeToBold(shts As Worksheet, vAddress As Variant)
' set the range on the sheet to bold
    Dim rRB As Range
    Dim vRC1, vRC2, vCells
    
    vCells = Split(vAddress, ":")
    With shts
        If UBound(vCells, 1) > 0 Then
            vRC1 = CellsFromRC(vCells(0))
            vRC2 = CellsFromRC(vCells(1))
            Set rRB = .Range(.Cells(vRC1(0), vRC1(1)), .Cells(vRC2(0), vRC2(1)))
        Else
            vRC1 = CellsFromRC(vCells(0))
            Set rRB = .Cells(vRC1(0), vRC1(1))
        End If
    End With
    Range2Bold rRB

End Sub

Sub Range2Bold(rRange As Range)
'Turn range to bold

    With rRange
        .Font.Bold = True
        .Font.Color = RGB(200, 20, 20)
    End With
    
End Sub

Function CellsFromRC(sRC) As Long()
'Return row and column number form RC notation

    Dim vS As Variant
    Dim lRC(1) As Long
    
    vS = Split(sRC, "C")
    lRC(0) = CLng(Replace(vS(0), "R", ""))
    lRC(1) = CLng(vS(1))
    CellsFromRC = lRC
End Function

Function GetShtNr(sName As String) As Long
'return the order number of the worksheet
    Dim sht As Worksheet
    Dim lC As Long
    
    For lC = 1 To Worksheets.Count
        If StrComp(sName, Worksheets(lC).Name) = 0 Then
            GetShtNr = lC
            Exit For
        End If
    Next lC
    
End Function
 
Upvote 0
Sorry I left a bit of code in here that is not required. The correct code:

VBA Code: 
Option Explicit

Sub GetRange()
' Get ranges from the user to turn to Bold text. _
  More ranges and on different sheets can be _
  selected at once.
  
    Dim vInp, vRanges, vEach, vCls, vSht
    Dim lR As Long, lS1 As Long, lS2 As Long
    Dim shts As Worksheet
    
    vInp = Application.InputBox(prompt:="Select range to change to Bold using mouse." _
                & vbCrLf & vbCrLf & "To add more ranges, type a """ & Application.International(xlListSeparator) _
                & """ then select the" & vbCrLf & "next range. You can also add ranges on " _
                & vbCrLf & "other sheets.", _
            Title:="Select range", _
            Type:=0)
    If StrComp(Left(vInp, 1), "=") Then Exit Sub    'cancelled or invalid
    vInp = Replace(vInp, "=", "")

    If Len(vInp) Then
        vRanges = Split(vInp, ",")
        For lR = 0 To UBound(vRanges, 1)
                vEach = Split(vRanges(lR), "!")
                If UBound(vEach, 1) = 1 Then    'other sheet(s) than activesheet
                    If vEach(0) Like "*:*" Then 'grouped sheets
                        vSht = Split(vEach(0), ":")
                        lS1 = GetShtNr(CStr(vSht(0)))
                        lS2 = GetShtNr(CStr(vSht(1)))
                        For lS1 = lS1 To lS2 Step IIf(lS2 > lS1, 1, -1)
                            Set shts = Worksheets(lS1)
                            SheetRangeToBold shts, vEach(1)
                        Next lS1
                    Else                        'single sheet
                        Set shts = Sheets(vEach(0))
                        SheetRangeToBold shts, vEach(1)
                    End If
                Else                            'no sheet name, so active sheet
                    Set shts = ActiveSheet
                    SheetRangeToBold shts, vEach(UBound(vEach, 1))
                End If
        Next lR
    End If
    'following because sometimes activesheet not displayed correctly
    Set shts = ActiveSheet
    Sheets(Sheets.Count).Activate
    shts.Activate
End Sub

Sub SheetRangeToBold(shts As Worksheet, vAddress As Variant)
' set the range on the sheet to bold
    Dim rRB As Range
    Dim vRC1, vRC2, vCells
    
    vCells = Split(vAddress, ":")
    With shts
        If UBound(vCells, 1) > 0 Then
            vRC1 = CellsFromRC(vCells(0))
            vRC2 = CellsFromRC(vCells(1))
            Set rRB = .Range(.Cells(vRC1(0), vRC1(1)), .Cells(vRC2(0), vRC2(1)))
        Else
            vRC1 = CellsFromRC(vCells(0))
            Set rRB = .Cells(vRC1(0), vRC1(1))
        End If
    End With
    Range2Bold rRB

End Sub

Sub Range2Bold(rRange As Range)
'Turn range to bold

    With rRange
        .Font.Bold = True

    End With
    
End Sub

Function CellsFromRC(sRC) As Long()
'Return row and column number form RC notation

    Dim vS As Variant
    Dim lRC(1) As Long
    
    vS = Split(sRC, "C")
    lRC(0) = CLng(Replace(vS(0), "R", ""))
    lRC(1) = CLng(vS(1))
    CellsFromRC = lRC
End Function

Function GetShtNr(sName As String) As Long
'return the order number of the worksheet
    Dim sht As Worksheet
    Dim lC As Long
    
    For lC = 1 To Worksheets.Count
        If StrComp(sName, Worksheets(lC).Name) = 0 Then
            GetShtNr = lC
            Exit For
        End If
    Next lC
    
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Copy and paste with input box
Replies
2
Views
128
Lacampeona
L
D
  • Solved
VBA Excel OpenDialogBox then Transfer the information to cell
Replies
5
Views
180
Daniza Morla
D
GMC The Macro Man
  • Solved
VBA Script - Return to named file
Replies
6
Views
119
mumps
mumps
D
  • Question
VBA Loop Through Named Ranges
Replies
1
Views
112
Jeffrey Mahoney
Jeffrey Mahoney
P
  • Solved
Button produces different result
Replies
3
Views
104
RoryA
RoryA

Forum statistics

Threads
1,214,651
Messages
6,120,738
Members
448,988
Latest member
BB_Unlv

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top