vba: user defined range

asurapan

Board Regular
Joined
Jul 12, 2005
Messages
84
i have a a spreadsheet that users will constantly be adding new rows and deleting rows. I need to run some code that will sort the rows in descending order, then loop thru and evaluate each row.

So i scraped some code up that allows the user to specifiy how many rows there are.

Sub Holdings_Range() 'this allows the user to dynamically increase or decrease the range as Vouchers expand
NumVouchers = Cells(4, 10) 'cell J4 has number 12 in it
Set EndRange = Range("G" & 15 + NumVouchers)
Set StartRange = Range("A15")
Range(StartRange, EndRange).Select
End Sub

The above works great as the proper range is selected.

But now I have trouble passing that same range for sorting. I currently have it hard-coded with 15 and 27.

ActiveWorkbook.Worksheets("perf").Sort.SortFields.Clear
'*****NEED TO MAINTAIN RANGE AS VOUCHERS EXPAND*****
ActiveWorkbook.Worksheets("perf").Sort.SortFields.Add Key:=Range("D15:D27"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("perf").Sort
'*****NEED TO MAINTAIN RANGE AS VOUCHERS EXPAND*****
.SetRange Range("A15:G27")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

And then I have trouble again passing the range to a loop which is also currently hard coded with 15 and 27.

For r = 15 To 27 Step 1
If Cells(r, 4).Value < Range("G10").Value Then
'Rows(r).ClearContents
Rows(r).Font.ColorIndex = 3 'red
End If

Next r

The sort and loops works fine hard-coded, but I just want to be able to pass the range from Holdings_Range() for the Sort and Loop.
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Straight after, or replace, the line:
Range(StartRange, EndRange).Select
have:
Range(StartRange, EndRange).Name = "RangeToSort"

Then elsewhere in the code you can refer to that range with:
Range("RangeToSort")

Later on, replace:
Code:
For r = 15 To 27 Step 1
        If Cells(r, 4).Value < Range("G10").Value Then
            'Rows(r).ClearContents
            Rows(r).Font.ColorIndex = 3 'red
        End If

with the likes of:
Code:
For each cll in Range("RangeToSort").columns(4)
        If cll.Value < Range("G10").Value Then
            'cll.entirerow.ClearContents
            cll.entirerow.Font.ColorIndex = 3 'red
        End If
 
Upvote 0
Code:
[color=darkblue]Sub[/color] Holdings_Range() [color=green]'this allows the user to dynamically increase or decrease the range as Vouchers expand[/color]

    [color=darkblue]Dim[/color] rngData [color=darkblue]As[/color] Range, rngD [color=darkblue]As[/color] Range, cell [color=darkblue]As[/color] Range
    
    [color=darkblue]Set[/color] rngData = Range("A15:G15").Resize(Range("J4").Value + 1) [color=green]'cell J4 has number 12 in it[/color]
    [color=green]'rngData.Select[/color]
    [color=darkblue]Set[/color] rngD = Range("D15").Resize(Range("J4").Value + 1)
    
    [color=darkblue]With[/color] Worksheets("perf").Sort
        .SortFields.Clear
        .SortFields.Add Key:=rngD, _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange rngData
        .Header = xlGuess
        .MatchCase = [color=darkblue]False[/color]
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] rngD
        [color=darkblue]If[/color] cell.Value < Range("G10").Value [color=darkblue]Then[/color]
            cell.EntireRow.ClearContents
            cell.EntireRow.ColorIndex = 3 [color=green]'red[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] cell

[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
for some reason when I use AlphaFrog's code below, I get an error from the following line

cell.EntireRow.ColorIndex = 3 'red
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

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