Dynamic Range With A Maximum End Point in Excel VBA - excel

I am using this line to find the end of a dynamic range starting in B9:
Sheets("Summary").Range("B9", Sheets("Summary").Range("B" & Rows.Count).End(xlUp))
The range may anywhere from 2 rows long to 20 rows long but I need to set a limit to the range at 21 rows.
How do I do this?
Thanks

Find the last row and check if it is greater then 21. If it is, then set the last row as 21. See this. Also it is advisable to work with objects and variables. Code becomes easier to handle :)
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
Dim lRowLimit As Long
Set ws = ThisWorkbook.Sheets("Summary")
'~~> Set the limit here
lRowLimit = 21
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
If lRow > lRowLimit Then lRow = lRowLimit
Set rng = .Range("B9:B" & lRow)
Debug.Print rng.Address
End With
End Sub
The range may anywhere from 2 rows long
Note: In such a case you want .Range("B9:B" & lRow) to be .Range("B1:B" & lRow)?

You need to count the rows in the same worksheet as you set the range. Therefore:-
Set Rng = Sheets("Summary").Range("B9", Sheets("Summary").Range("B" & Sheets("Summary").Rows.Count).End(xlUp))
But if you want to limit the end row you should determine a row number, like this.
Dim Rng As Range
Dim Rl As Long ' last row
With Sheets("Summary")
Rl = WorksheetFunction.Min(.Range("B" & .Rows.Count).End(xlUp).Row, 21)
Set Rng = Range(.Range("B9"), .Cells(Rl, "B"))
End With

Also
Sub Test()
Const MaxRow = 29
Dim MyRange As Range
With Sheets("Summary")
Set MyRange = .Range("B9", "B" & IIf(.Range("B" & Rows.Count).End(xlUp).Row > MaxRow, MaxRow, _
.Range("B" & Rows.Count).End(xlUp).Row))
End With
End Sub

Related

Proper /Shorter code to select a Range from after Last Row till end of usedRange, VBA?

I need to select a Range from after Last Row till end of usedRange.
The below code works, But is there Proper /Shorter code.
Option Explicit
Sub Select_Blank_in_Usedrange()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim LastR As Long, LastR_UsedRange As Long
LastR = ws.Cells(Rows.Count, "A").End(xlUp).Row
LastR_UsedRange = ws.UsedRange.Rows.Count
ws.Range("A" & LastR + 1, "AE" & LastR_UsedRange).Select
End Sub
If the code works and has no redundant parts, I would say it's good. If I were to suggest an improvement, it would be to save the relevant addresses as Range Objects instead of Row numbers. This way you can assemble the larger range directly from the two corners, instead of having to concatenate the address in the final step.
Sub Select_Blank_in_Usedrange()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim TopCorner As Range
Set TopCorner = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0)
Dim BottomCorner As Range
With ws.UsedRange.Columns(31)
Set BottomCorner = .Cells(.Cells.Count)
End With
ws.Range(TopCorner, BottomCorner).Select
End Sub
To me, this is much clearer, and the constants are clearly displayed. This will make it easier to edit later, if the number of columns changes, or if the starting column moves from "A".
The shortest code will be the next:
Dim ws As Worksheet: Set ws = ActiveSheet
ws.Range("A" & ws.Range("A" & ws.rows.count).End(xlUp).row + 1, _
"AE" & ws.UsedRange.rows.count + ws.UsedRange.cells(1).row - 1).Select
It will also deal with the case when UsedRange does not start from the first row...

How to make each cell's length to be 5?

I have a column with 7000+ names. I want to make each name's length not excess to 5. Here is what I have tried which doesn't work
Sub del()
Dim myCell
Set myCell = ActiveCell
Dim count As Integer
count = Len(ActiveCell)
While count > 5
myCell = Left(myCell, Len(myCell) - 1)
myCell.Offset(1, 0).Select
Set myCell = ActiveCell
Wend
End Sub
No need for VBA. You can use a formula, =Left(A1,5), to get the first 5 characters of the cell. Simply autofill the formula down.
If you still want VBA then also you do not need to loop. See this example. For explanation see Convert an entire range to uppercase without looping through all the cells
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A1:A" & lRow)
rng = Evaluate("index(left(" & rng.Address(External:=True) & ",5),)")
End With
End Sub
In the above code I am assuming that the data is in column A in Sheet1. Change as applicable.
In Action

VBA Excel condition-based negative values don't work

I would like to set up the different formula for negative and positive values.
My code below suppose to be valid, but only the formula for negative values work.
Dim wks As Worksheet
Dim sunString As String
Dim rng3 As Range
sunString = "-"
Set wks = ThisWorkbook.ActiveSheet
Set rng3 = wks.Range("F2:F" & lRow)
With rng3
If InStr(sunString, "-") > 0 Then
Range("W2:W" & lRow).Formula = "=R2-U2-V2"
Else
Range("W2:W" & lRow).Formula = "=R2+U2+V2"
End If
The second formula (else statement) doesn't work at all.
What is wrong here?
Why not use a single formula that includes the condition and get rid of the unneeded looping?
Sub LoopRange()
Dim wks As Worksheet
Dim lRow As Long
Dim rng As Range
Set wks = ThisWorkbook.ActiveSheet
lRow = wks.Cells(wks.Rows.Count, "F").End(xlUp).Row
Set rng = wks.Range("W2:W" & lRow)
rng.Formula = "=IF(F2<0,R2-U2-V2 ,R2+U2+V2)"
End Sub
If the data in column F is not numeric you could use this formula to check for -.
rng.Formula = "=IF(LEFT(F2)=""-"",R2-U2-V2 ,R2+U2+V2)"

specific values in 2 cells on same row in different columns if

wht i want is if cell value in column A is 60 then cell value in the same row in column C must equal FF code below.
Sub column_check2()
Dim c As Range
Dim alastrow As Long
Dim clastrow As Long
alastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
clastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
For Each c In Range("A2:A3" & alastrow & ",C2:C3" & clastrow)
If Not c.Value = "60" And c.Value = "FF" Then
MsgBox "error" & c.Address
End If
Next c
End Sub
You just need to loop through each value in Column A and check your criteria (Cell = 60). You can then adjust the value in Column C by using Offset to navigate 2 cells to the right from the current cell in the loop
Sub Looper()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Update Sheet Name
Dim lr As Long, Target As Range
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
For Each Target In ws.Range("A2:A" & lr)
If Target = 60 Then
Target.Offset(0, 2) = "FF"
End If
Next Target
End Sub
Even better, consider the way you would likely do this manually. Filter Column A for your target value and then just modify the resultant cells in Column C. Recreating this in VBA results in a solution more efficient than a loop (the larger the data set, the larger the efficiency gains)
Sub Filter()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long: lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A1:A" & lr).AutoFilter Field:=1, Criteria1:=60 'Filter
ws.Range("C2:C" & lr).SpecialCells(xlCellTypeVisible).Value = "FF" 'Apply Values
ws.AutoFilterMode = False 'Remove Filter
End Sub

Add offset to a last row

I just want to add an offset (0,6) to my lastRow . any help?
lastRow = oSht.Range(vari1 & Rows.Count).End(xlUp).Row
After your clarification I could suggest that you could do it by range expansion. Instead of Offset you could use Resize.
As you said this is working correct for your S column:
oSht.Range(vari2, vari1 & lastRow).Select
After we add resize to that you get your new range:
oSht.Range(vari2, vari1 & lastRow).Resize(,6).Select
I think this is what you want?
Option Explicit
Sub Sample()
Dim oSht As Worksheet
Dim lastRow As Long
Dim Rng As Range
Dim vari1 As String
'~~> Change this to the relevant column letter
vari1 = "S"
'~~> Change this to the relevant sheet
Set oSht = ThisWorkbook.Sheets("Sheet1")
With oSht
lastRow = .Range(vari1 & .Rows.Count).End(xlUp).Row
Set Rng = .Range(vari1 & 2 & ":" & .Range(vari1 & lastRow).Offset(, 6).Address)
'~~> S2:X32 in your case if lastrow is 32
Debug.Print Rng.Address
End With
End Sub

Resources