Dynamic Array for Sort and Clear contents - vba

I have made an array for M2:Tx - The x will vary dependent code prior to this.
What I would like to do is have a 'clear contents' function and 'sort' function for this array (m2:tx).
I am just struggling to make the array DYNAMIC. If anyone could help.
I believe it will be something along these lines:
k = sh.Range("A3").End(xlDown).Row 'This will give me the length.
Dim TaskDates As Range
Dim StartCell As Range 'First part of Array
Dim EndCell As Range 'End of Array
Set EndCell = Range("T" & 2 + k) 'maybe 2 or 3
Set StartCell = Range("M2")
Set TaskDates = Range(StartCell, EndCell) 'Dynamic Range
This will work i beleive, but is there a more succinct methodology.

I don't really understand the logic by which you are setting your range.
If you want the last row in the range that starts with M2 to be the same as the last occupied row in Column A, then. in general
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
So to set your range M2:Tx where x = LastRow
Set TaskDates = Range("M2", "T" & Cells(Rows.Count, "A").End(xlUp).Row)
To sort the range, decide how you want it sorted, then record a macro.

Here is one way:
Sub MakeRange()
Dim x As Long, MyDynamicRange As Range
x = 123
Set MyDynamicRange = Range("M2:T" & x)
MsgBox MyDynamicRange.Address(0, 0)
End Sub

Related

VBA Modify Range when value is observed

I'm trying to get a sub to work that will color fields based on when the values "TRUE" or "FALSE" appears. I've already asked the below question, and have arrived at the code, also below.
VBA Excel Format Range when value is found
Option Explicit
Public Sub MarkCellsAbove()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet2")
Dim v As Variant
Dim i As Long, j As Long, n As Long, m As Long, r As Long, y As Long
Dim rng As Range
Dim rCell As Range
Dim DynamicArea As Range
Dim t As Double
' get last row in column C
n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
' get last column from A
y = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' set dynamic area to above values
Set DynamicArea = ws.Range(Cells(1, 1), Cells(n, y))
' clear existing colors over the WHOLE column to minimize file size
DynamicArea.Interior.ColorIndex = xlColorIndexNone
For Each rCell In DynamicArea
Select Case rCell.Text
Case "TRUE"
Set rng = rCell.Offset(-2, 0)
rng.Interior.ColorIndex = 4
Case "FALSE"
Set rng = rCell.Offset(-2, 0)
rng.Interior.ColorIndex = 5
End Select
Next
End Sub
This works well - I am able to color the cell 2 rows above where FALSE or TRUE is found. However - I would like to color not just this cell, but all cells in the range specified by Offset. So, if I specify 8 cells above, I would like to color 8 cells.
I hope someone can help - I'm so close to finishing this!
Try
Set rng = Range(rCell.Offset(-8, 0), rCell.Offset(-1, 0))
Note that you will get a runtime error if rCell is not at least in row 9

How to copy a range of cells to another column in VBA?

Working Environment: Excel 2013
Target: Copy C1:C9 to B11:B19. D1:D9 to B21:B29. E1:E9 to B31:B39.....
After copying all the range to column B, copy A1:A9 to A11:A19(A21:A29....)
My idea is that:
1. select a range by using something like
range.end()
because in some of my sheets, there are only 4 test steps. so I need a syntax which can self inspect the used cells in a column.
do a range copy to column B.
leave 1 row in between considering about the page layout.
My piece of code is:
Worksheets("Master").Columns(3).UsedRange.Copy
Worksheets("Master").Range("B11").PasteSpecial
but seems like the Columns(i).UsedRange.Copy doesn't work. the pastespecial works.
My question is:
How to select the used range in columns? The number of columns are not fixed which means some of the sheets have 40 columns, but some of the other have maybe 30.
Thanks!
I attached one screenshot of the sheet for your reference.
Assuming you do not have more data in the columns to be copied, this should work
Sub copyToOneColumn()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Master")
Dim startCol As Integer
startCol = 3
Dim endCol As Integer
endCol = 10
Dim startRange As Range
Dim ra As Range
For i = startCol To endCol
Set startRange = ws.Range("A1").Offset(0, i - 1)
Set ra = ws.Range(startRange, ws.Cells(Rows.Count, startRange.Column).End(xlUp))
ra.Copy Destination:=ws.Range("B" & Rows.Count).End(xlUp).Offset(2, 0)
Next i
End Sub
You can do a copy (not technically a copy as it doesn't use the clipboard) directly like so:
Range("B1").Resize(Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Rows.Count,1) = Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Value
Effectively you are looking at B1 then resizing that to a range to be the number of columns in column A that are used with this: Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Rows.Count
Then you are making this new range in column B = to the values of the same range in column A.
Note, this can be shortened if you are always starting at row 1 but the code I have given you will suffice if you start at a different row.
You may try something like this...
Sub CopyData()
Dim wsMaster As Worksheet
Dim lr As Long, lc As Long, r As Long, c As Long
Application.ScreenUpdating = False
Set wsMaster = Sheets("Master")
lr = wsMaster.Cells(Rows.Count, 1).End(xlUp).Row
lc = wsMaster.Cells(1, Columns.Count).End(xlToLeft).Column
r = lr + 2
If lr <= 9 Then
For c = 3 To lc
wsMaster.Range(wsMaster.Cells(1, c), wsMaster.Cells(lr, c)).Copy wsMaster.Range("B" & r)
wsMaster.Range("A1:A" & lr).Copy wsMaster.Range("A" & r)
r = wsMaster.Cells(Rows.Count, 2).End(xlUp).Row + 2
Next c
End If
Application.ScreenUpdating = True
End Sub

Variable for RowNum of first and last integer in a column and creating a range between the 2

I want to create two variables, one for the row number of the first integer in column J and one for the last integer in column J (after this there are many rows of #N A N A). I then would like to use these two points to create a range for column J but also for column D (using the same variables)
I just started using vba earlier this week, understand the simplicity and I have found similar answers elsewhere but none quite so specific. Any help would be much appreciated. What I have so far:
Dim StartRow As Integer
Dim sht As Worksheet
Dim LastRow As Integer
Dim JRange As Range
Dim DRange As Range
Set StartRow = Range("j7:j100").SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1, 1).Row
LastNonRow = sht.Cells(sht.Rows.Count, 8).End(xlUp).Row (I fear this includes the #N A N A rows too)
Set JRange = sht.Range(StartRow,10,sht.Cells(LastRow,10))
Set DRange = sht.Range(StartRow,4,sht.Cells(LastRow,4))
First, you should use:
Set JRange = sht.Range(sht.Cells(StartRow,10),sht.Cells(LastRow,10))
Second, don't use the Set keyword with Integer or other value types. The Set keyword is only for use with objects. If you are not familiar with object vs. value types, you should do some research on that. Here are some Excel VBA examples:
Dim i As Integer
Dim j As Double
dim str as String
Dim coll As Collection
dim sht As Worksheet
dim rng As Range
i = 1
j = 2.4
str = "This is a string of text, also a value type"
Set coll = ThisWorkbook.Sheets 'Note that ThisWorkbook.Sheets is a Collection
Set sht = coll(1) 'sets sht to the first Sheet in coll
Set rng = sht.Range("A1")
If you just care whether a number is in the cell and not necessarily an integer, you can do something like this
'Use Double instead of Integer because the possible range of values is larger.
'This reduces risk of error
Dim LastRow As Double
Dim UpperLimit As Double
'Assuming you already have StartRow
LastRow = StartRow + 1
'Use UpperLimit to ensure you don't go into an infinite loop
'Set UpperLimit to an appropriately high value
UpperLimit = 100000
'Test Loop
Do While IsNumeric(sht.Cells(LastRow,10).Value) and LastRow <= UpperLimit
LastRow = LastRow + 1
Loop
'Check if it exceeded upper limit
If LastRow > UpperLimit Then
MsgBox "Exceeded Limit"
Exit Sub
End If
LastRow = LastRow - 1 'Because the sht.Cells(LastRow,10).value is non-numeric
'Now set ranges
If you care whether it is actually an integer, you can use the above code, but put a conditional statement inside the loop to test whether the number is indeed an integer. There are many resources on the web that give code for determining whether value is an integer.
Also, you should make sure you set the sht variable before you use it.
Set sht = ThisWorkbook.Sheets(1)
Or
Set sht = ThisWorkbook.Sheets("MySheetName")
Hope this helps.
EDIT:
If the range is not continuous with integers, reverse the loop:
LastRow = UpperLimit
Do Until IsNumeric(sht.Cells(lastRow,10).Value)) Or LastRow = StartRow
LastRow = LastRow - 1
Loop
If you do this, remove the LastRow = LastRow-1 from the end of the code as the value you are looking for is already in LastRow.
There's a bunch of issues with your code:
Set StartRow - You only use Set when you're creating an object.
Also there's an issue with referencing the cells. There are a bunch of different ways to do this, I suggest to read up on this.
The following will take the first row with a number and the last row with a number, even if there are Non-number values in between. It will run on the currently active sheet.
Sub test()
Dim StartRow As Integer
Dim LastRow As Integer
Dim JRange As Range
Dim DRange As Range
Dim RangeForLoop As Range
StartRow = Range("J7:J100").SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1, 1).Row
For Each RangeForLoop In Range("J7:J100").SpecialCells(xlCellTypeConstants, xlNumbers).Cells
LastRow = RangeForLoop.Row
Next RangeForLoop
Set JRange = Range("J" & StartRow & ":J" & LastRow)
Set DRange = Range("D" & StartRow & ":D" & LastRow)
End Sub

Find Last cell from Range VBA

How to find location of last cell from defined Range? Cell does not have to contain any data but must be most right and most down located cell from certain Range.
Set rngOrigin = wksOrigin.Cells(IntFirstRow, IntFirstColumn).CurrentRegion
I wish to receive
Cells(i,j)
Perhaps this is what you want:
Dim rngLastCell As Range
Set rngLastCell = rngOrigin(rngOrigin.Count)
maybe you're after this:
'absolute indexes from cell A1
With rngOrigin
i = .Rows(.Rows.count).row
j = .Columns(.Columns.count).Column
End With
'relative indexes from rngOrigin upleftmost cell
With rngOrigin
i = .Rows(.Rows.count).row - .Rows(1).row + 1
j = .Columns(.Columns.count).Column - .Columns(1).Column + 1
End With
I handled it in below code but your remarks were helpful. Thank you.
intLastRow = rngOrigin.Cells(1, 1).Row + rngOrigin.Rows.Count - 1
intLastCol = rngOrigin.Cells(1, 1).Column + rngOrigin.Columns.Count - 1
The answers given by others mostly work, but not if the region is a union of non-contiguous cells. Here is a version that works consistently for single and multi-area regions, contiguous and non-contiguous.
Function LastCellOfRange(rng As Excel.Range) As Excel.Range
Dim area As Excel.Range
Dim rowNum As Long
Dim maxRow As Long
Dim colNum As Long
Dim maxCol As Long
Dim areaIdx As Integer
Set LastCellOfRange = Nothing
maxRow = 0
maxCol = 0
For areaIdx = 1 To rng.Areas.Count
Set area = rng.Areas(areaIdx)
rowNum = area.Cells(area.Cells.Count).row
If (rowNum > maxRow) Then
maxRow = rowNum
End If
colNum = area.Cells(area.Cells.Count).Column
If (colNum > maxCol) Then
maxCol = colNum
End If
Next areaIdx
Set LastCellOfRange = rng.Worksheet.Cells(maxRow, maxCol)
Set area = Nothing
End Function
Use this to code find the last cell in a given range
Sub GetLastCellFromRange()
Dim rng As Range
Set rng = Range("$C$10:$E$20")
'Set rng = Range(Selection.Address) ' Use this line to select the range in worksheet
MsgBox "Last Cell of given range is : " & rng.Cells(rng.Rows.Count, rng.Columns.Count).Address
End Sub
I hope it will help you
you could try the following but it relies upon cells always being populated
rngOrigin.End(xlDown).End(xlRight)
or you could use the CurrentRegion and count the rows and columns and use Offset
Alternatively, you could use this construct which works even with ranges based on entire rows or entire columns.
Sub Test()
Dim rngOrigin As Excel.Range
Set rngOrigin = Range("$A$1:$D$6")
Dim rngLast As Excel.Range
Set rngLast = rngOrigin.Cells(rngOrigin.Cells.Count)
Debug.Print rngLast.Address
End Sub
Finally, for ranges with multiple areas you'll have to script against a range's Areas collection ...
Sub Test()
Dim rngOrigin As Excel.Range
Set rngOrigin = Range("$A$1:$D$6,$F$1:$G$6")
Debug.Print rngOrigin.Areas(1).Cells(rngOrigin.Areas(1).Cells.Count).Address
Debug.Print rngOrigin.Areas(2).Cells(rngOrigin.Areas(2).Cells.Count).Address
End Sub
Many answers here will work as long as the given range is continuous. This is what I would use for a range that you are absolutely sure is going to be continuous:
Sub test()
Dim myRng As Range, lastCell As Range
Set myRng = Range("A1:D4")
Set lastCell = myRng.Cells(myRng.Rows.Count, myRng.Columns.Count)
Debug.Print lastCell.Address 'returns $D$4
End Sub
For non-continuous, DB user10082797 gave a great solution, however their function fails when the ranges are positioned diagonal-up (for example, if you pass rng=A3:B4,C1:D2 in you will get D4 as the output which was not part of the original range.)
So the question becomes, what is the last cell in the range A3:B4,C1:D2? Is it B4 or D2? That's a decision for the programmer. Here is a function I wrote with the help of DB user10082797's function:
Function LastCellOfRange(rng As Range, Optional returnLastRow As Boolean = True) As Range
'returns the last cell in #rng.
'if #returnLastRow is TRUE, then the output will always be in the right most cell of the last row of #rng
'if #returnLastRow is FALSE, then the output will always be in the bottom most cell of the last column of #rng
'(#returnLastRow only matters for non-contiguous ranges under certain circumstances.)
'initialize variables
Dim area As Range, areaIdx As Long
Dim lastCellInArea As Range
'loop thru each area in the selection
For areaIdx = 1 To rng.Areas.Count
Set area = rng.Areas(areaIdx) 'get next area
Set lastCellInArea = area.Cells(area.Rows.Count, area.Columns.Count) 'get the last cell in the area
'if:
' the return is empty
' OR if the last row needs to be returned and this row is larger than the last area's
' OR if the last row needs to be returned and this row is the same as the last area's but has a larger column
' OR if the last column needs to be returned and this column is larger than the last area's
' OR if the last column needs to be returned and this column is the same as the last area's but has a larger row
'THEN:
' make this cell the return range
If LastCellOfRange Is Nothing Then
Set LastCellOfRange = lastCellInArea '(must be seperate from the other statment when its not set to anything)
ElseIf _
returnLastRow = True And lastCellInArea.Row > LastCellOfRange.Row _
Or returnLastRow = True And lastCellInArea.Row = LastCellOfRange.Row And lastCellInArea.Column > LastCellOfRange.Column _
Or returnLastRow = False And lastCellInArea.Column > LastCellOfRange.Column _
Or returnLastRow = False And lastCellInArea.Column = LastCellOfRange.Column And lastCellInArea.Row > LastCellOfRange.Row _
Then
Set LastCellOfRange = lastCellInArea
End If
Next areaIdx
End Function
You can use the function like this:
Sub test()
Dim myRng As Range
Set myRng = Range("A3:B4,C1:D2")
Debug.Print LastCellOfRange(myRng).Address 'returns $B$4
Debug.Print LastCellOfRange(myRng, False).Address 'returns $D$2
End Sub
In your case, since you want to find the cell to the most right and down in your wksOrigin (defined as Worksheet), you could use the SpecialCells(xlCellTypeLastCell) to get the last cell Row and Column.
i = wksOrigin.Cells.SpecialCells(xlCellTypeLastCell).Row ' <-- get last row number
j = wksOrigin.Cells.SpecialCells(xlCellTypeLastCell).Column ' <-- get last column number
If you want to debug your result, you can add:
MsgBox "Last row at " & i & ", last column at " & j
If you want the absolute last cell of a defined range, regardless of whether it has any content, here is a simple solution
Dim InputRng As Range 'define a range for the test'
Set InputRng = Range("$F$3:$F$15")
MsgBox InputRng(1).Address & ":" & InputRng(InputRng.Cells.Count).Address 'This would output the absolute address of defined range'

Select cells that fit in the range of the counter and concatenate what is selected from the range

I've been working on a Macro that i need to copy, concatenate what has been selected through the counter. e.g. is below
excel snapshot example
so what i want to do is set a count in column c from 1 to "infinite" because each worksheet varies to go up to 10 or hundreds and when the counter hits a value of 1 again to stop concatenate column D what is in the range from 1 to "the last digit it stopped before hitting 1 again" and paste it on a different sheet. I know little to nothing on VBA but I understand the copy and paste to different sheet part. I'm just stuck on the counter and the concatenate part. Here is the code i have so far(i edited it to resemble the example for better reference)
'select counter/concatenate
Sheets(1).Select
Columns("C").EntireColumn
Do
Columns("C").Count
For i = 1 To 9999
Loop While (i <= 1)
If i = 1 Then
select.columns("D")
after the count is where i am stuck. this count is what I've come up with looking at different variations of counters.
I suggest you Forget about column and use just one cell for easier understanding. A cell is a reference that allows you to refer to any other cells on the sheet by using Offsets. You may use two Loops, the outer one crawling the columns, the inner one working downward until it finds 1
Dim i As Long ' note that in VBA integer Overflows at 65535 rows
Dim s As String
Set aCell = Worksheet("Sheet1").Range("D1")
While aCell.Column < 255
i = 0
s = ""
While Not aCell.Offset(i, 0).Value = 1
s = s & aCell.Offset(1, 0).Value
Wend
' paste s somewhere by using range.value = s
Set aCell = aCell.Offset(0, 1)
Wend
By specifying the workbook and worksheet before the range, you may refer to the proper cell without being dependent on the active worksheet or range.
Hope this works for you.
You can try this (not tested):
Dim s As String, firstAddr as String
Dim f as range, iniCell As Range
With Worksheet("MySheet") '<--| change "MySheet" to your actual sheet name
With .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
Set f = .Find(What:=1, LookAt:=xlWhole, LookIn:=xlValues, After:=.Cells(.Rows.Count, 1))
If Not f Is Nothing Then
firstAddr = f.Address
Set iniCell = f
Set f = FindNext(f)
Do While f.Address <> firstAddr
s = s & Join(Range(iniCell, f.Offset(-1)).Offset(, 1), "")
' here code to paste s somewhere
Set iniCell = f
Set f = FindNext(f)
Loop
End If
End With
End With
Here's one I actually tested, using some random data in columns C and D.
You'll have to modify a little to get exactly where you want the data to go, but should get you in the right direction.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim s As String
Dim lastRow As Long
Dim c As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
lastRow = ws1.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'This will get an accurate last row
c = 1
For i = 1 To lastRow
s = s & ws1.Cells(i, 4).Value 'Build the string
If ws1.Cells(i + 1, 3).Value = 1 Or ws1.Cells(i + 1, 3).Value = "" Then
ws2.Cells(c, 1).Value = s
s = ""
c = c + 1
'If the next cell to check is 1 or blank, then copy the values to the next cell in order on sheet2
End If
Next
End Sub
Walking through it, lastRow is set using the last row in the sheet with a value in it. Then, c is set to one, although you could set this to the last available row in ws2 using the same process. After that it just steps through the rows from 1 To LastRow building strings and transferring the value to ws2 when it's about to hit a 1.