VBA to use individual row from a multi row Range - vba

Assuming I am creating a temporary range variable as follows
With wsProj
Set projStartCell = .Range("D8")
Set startCell = .Columns(StartCellSearchColumn).Find(What:=TargetText, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
Set tempRangeEnd = projStartCell.End(xlToRight).Offset(1, 0)
Set tempRange = .Range(startCell, tempRangeEnd)
' insert two news rows and ensure they have no fill
tempRange.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Set insertedRange = tempRange.Offset(-2, 0)
Call ClearRangeOfFill(insertedRange)
So now I have the correct range that I want and I need to format each of the two rows in that range individually, as they have different formats.
Can you format each row individually? i.e. insertedRange.Row(1) for the first row of the range(yeah, but that doesnt work obviously)
Or do I have to create a temporary range for each row and then format it and do it again for the next row?

Range.Row is a Long Property, which provides the first row of the specified Range, and does not accept arguments. Example:
MsgBox insertedRange.Row 'What row does the insertedRange start on?
Range.Rows is a Range Property, which provides a Object representing the specified Rows of the Range, and accepts either a numerical argument for a single row, or a text argument for multiple rows. Example:
insertedRange.Rows(1).Interior.ColorIndex = 3 'Make the first row Red
insertedRange.Rows("3:5").Interior.ColorIndex = 5 'Make the third, fourth & fifth rows Blue
As such, you should be using insertedRange.Rows(1), not insertedRange.Row(1)
(It's an easy mistake to make, and the same applies to Range.Column and Range.Columns. If you want the full Row/Column, you need to add the .EntireRow property or the EntireColumn property)

Related

Count the number of cells in a found column using VBA

I am pretty new to VBA and I have been fighting with creating one simple report for many days so I decided to inquire for some help. I will be really grateful for any tips you have or could point to any errors I might've made in my code.
I have the below piece of code (extracted from my loop). What I want to do is to create a list based on around 20 excel files that will have below stats:
name of the current tab inside the workbook
count of nonblanks in a column which name contains word "Difference" (always in row 7 but can be in different columns)
count from the same column but where cells are not blank AND different than 0.
For the last stat I didn't even start so you won't see it in my code but I would appreciate if you have any tips for this one too (which method best to use).
Windows("PassRate.xlsm").Activate
b = ActiveSheet.Cells(Rows.count, 2).End(xlUp).Row + 1
Cells(b, 3) = xlWorkBook.Worksheets(i).Name
xlWorkBook.Worksheets(i).Activate
Set Myrng = Range("B7:M9999").Find(What:="Difference", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False)
If Not Myrng Is Nothing Then
RowQnt = xlWorkBook.Worksheets(i).Myrng.Offset(9999, 2).Cells.SpecialCells(xlCellTypeConstants).count
End If
Windows("PassRate.xlsm").Activate
Cells(b, 4) = RowQnt
My problem is that the macro runs and works, but the result I get is the list of tab names but all counts are 0 and I cannot overcome this issue. For the line number 7 I've also tried the piece of code below which yields the same result.
RowQnt = xlWorkBook.Cells(Rows.count, Myrng).End(xlUp)
Is it possible that my problem is due to the fact that in the source files the column containing word "Difference" is sometimes two merged columns? Unfortunately, I cannot change that as these are some automatically generated files from another program.
xlWorkBook.Worksheets(i).Myrng isn't a valid Range syntax while you can simply use MyRng which you already set to a not null Range reference and already has both parent worksheet and workbook references inside it
but even Myrng.Offset(9999, 2).Cells wouldn't do since it references one cell only and not a range of cells
you need a Range(Range1, Range2) syntax, where both Range1 and Range2 are valid Range references to the first and last cell of the range you actually want to count not blank cells of
furthermore you could use WorksheetFunction.CountA() function instead of SpecialCells(xlCellTypeConstants) range, since this latter errors out if no constant cells are found in the range it's being applied to (so you'd need a check) while the former simply returns zero if no not empty cells are found
for all what above you could write the following GetRowQnt() function:
Function GetRowQnt(sht As Worksheet) As Long
Dim Myrng As Range
With sht '<--| reference passed worksheet
Set Myrng = .Rows(7).Find(What:="Difference", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False) '<--| find "Difference" in its 7th row
If Not Myrng Is Nothing Then GetRowQnt = WorksheetFunction.CountA(.Range(.Cells(8, Myrng.Column), .Cells(WorksheetFunction.Max(.Cells(.Rows.count, Myrng.Column).End(xlUp).row, 8), Myrng.Column))) '<--| count not blank cells in column where "Difference" was found from row 8 down to its last not empty cell
End With
End Function
and use it in your main code as follows:
With Windows("PassRate.xlsm").ActiveSheet '<--| reference "PassRate.xlsm" workbook active sheet (or change 'ActiveSheet' with 'Worksheetes("yourSheetName")')
For i = 1 To xlWorkbook.Worksheets.count '<--| loop through 'xlWorkbook' workbook worksheets
b = .Cells(.Rows.count, 3).End(xlUp).row + 1 '<--| get "PassRate.xlsm" workbook active sheet current first empty cell in column "C"
.Cells(b, 3) = xlWorkbook.Worksheets(i).Name
.Cells(b, 4) = GetRowQnt(xlWorkbook.Worksheets(i))
Next
End With
please note that with
b = .Cells(.Rows.count, 3).End(xlUp).row + 1
I took column "C" as the leading one to get last not empty row from, since there was no code in your post that wrote something in column "B".
But if your real code has some
.Cells(b, 2) = somedata '<--| write something in column "B" current row
then you can go back to b = .Cells(.Rows.count, 2).End(xlUp).row + 1

Excel UDF to find first and last cell in range with a given value - runs slowly

I'm writing a function which takes a column range and finds the first and last cell in that column which have a certain value. This gives a first row number and a last row number that are then used to return the corresponding subrange in another column.
The idea is that with this function I can apply Excel functions to a (continuous) subsection of a range. E.g. suppose I have a table with various prices of Apples and Bananas, grouped so that all prices of Apples come first, then Bananas. I want to find the minimum price of Apples and the minimum of Bananas, but selecting the whole range and without changing the range over which to minimise. I would use my desired function to feed a range to Excel's MIN function which included just Apples, or just Bananas, without having to manually select these subranges. A MINIF, if you will - like a weak version of SUMIF but for MIN (and potentially many other functions).
I've found a way of doing it but it's running really quite slow. I think it may have to do with the for loop, but I don't understand enough about efficiency in Excel/VBA to know how to improve it. I'm using this code on an Excel table, so the columns I pass are named columns of a table object. I'm using Excel 2010 on Windows 7 Enterprise.
Grateful for any help. Even solutions on how to conditionally apply functions to ranges that deviate radically from this are well received.
Code:
' ParentRange and CriterionRange are columns of the same table.
'I want to extract a reference to the part of ParentRange which corresponds
'by rows to the part of CriterionRange that contains cells with a certain value.
Function CorrespondingSubrange(CriterionRange As Range, Criterion As _
String, ParentRange As Range) As Range
Application.ScreenUpdating = False
Dim RowCounter As Integer
Dim SubRangeFirstRow As Integer
Dim SubRangeFirstCell As Range
Dim SubRangeLastRow As Integer
Dim SubRangeLastCell As Range
Dim RangeCountStarted As Boolean
RangeCountStarted = False
Set SubRangeFirstCell = CriterionRange.Find(What:=Criterion, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not (SubRangeFirstCell Is Nothing) Then
RangeCountStarted = True
SubRangeFirstRow = SubRangeFirstCell.Row - CriterionRange.Range("A1").Row + 1
For RowCounter = SubRangeFirstRow To CriterionRange.Cells.Count
If Not (CriterionRange.Cells(RowCounter, 1).Value = Criterion) Then
SubRangeLastRow = RowCounter - 1
Exit For
End If
Next
End If
If RangeCountStarted = True And SubRangeLastRow = 0 Then SubRangeLastRow = RowCounter
Set CorrespondingSubrange = ParentRange.Range("A" & SubRangeFirstRow & ":A" & SubRangeLastRow)
Application.ScreenUpdating = True
End Function
I don't like using VBA when an Excel formula can be used efficiently.
First of all, you can get a minimum or maximum according to conditions using a simple IF in an array formula (enter the formula using Ctrl + Shift + Enter. This will add the surrounding {} that indicate an array formula):
=MIN(IF($A$1:$A$10=D1,$B$1:$B$10))
This formula checks in A for the condition in D1 and returns the corresponding value from B. Notice that your data doesn't even need to be ordered for this formula to work:
Second, if you want to keep getting the first and last row numbers, you can use this very formula with a minor addition. However, I suspect that one would use the INDIRECT or OFFSET functions with these values, which is unnecessary and inefficient, as this functions are volatile. Regardless, the addition to the formula is the ROW function. (This formula will need the data to be ordered of course). Array formula for row numbers:
=MAX(IF($A$1:$A$10=D1,ROW($A$1:$A$10)))
This will return the last row number for Bananas.
By settiing Find SearchDirection to xlPrevious you can easily Find the last occurrence in a range.
Toggling Application.ScreenUpdating has little effect when you are just reading values. I prefer shorter variable names. Longer names tend to clutter the screen and make it harder to see what's going on. But's that's just my opinion.
Function CorrespondingSubrange(rCriterion As Range, Criterion As _
String, rParent As Range) As Range
Dim FirstCell As Range
Dim LastCell As Range
Set FirstCell = rCriterion.Find(What:=Criterion, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set LastCell = rCriterion.Find(What:=Criterion, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False)
If Not (FirstCell Is Nothing) Then
Set CorrespondingSubrange = rParent.Range("A" & FirstCell.Row & ":A" & LastCell.Row)
End If
End Function
My answer is similar to the VBA UDF solution posted earlier by Thomas Inzina with a couple of differences.
The After:= parameter is used to ensure that the first match found is the first match in the range. The Range.Find method uses a 'tin-can' approach where it loops through the cells of hte range and restarts at the beginning once it reaches the end. By starting After:=.Cells(.Cells.Count) and moving in a forward direction, you will find hte first cell in the range that matches. Similarly, by starting at After:=.Cells(1) and moving SearchDirection:=xlPrevious you will quickly find the last without looping.
I've also used the Intersect method to a) cut down full column references to the Worksheet.UsedRange property and b) to quickly return the working range from the determined criteria range.
Function CorrespondingSubrange(rngCriterion As Range, Criterion As String, _
rngWorking As Range) As Variant
Dim SubRangeFirstCell As Range
Dim SubRangeLastCell As Range
'set the return value to an #N/A error (success will overwrite this)
CorrespondingSubrange = CVErr(xlErrNA)
'chop any full column references down to manageable ranges
Set rngCriterion = Intersect(rngCriterion, rngCriterion.Parent.UsedRange)
With rngCriterion
'look forwards for the first occurance
Set SubRangeFirstCell = .Find(What:=Criterion, After:=.Cells(.Cells.Count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SubRangeFirstCell Is Nothing Then
'there is at least one of the criteria - now look backwards
Set SubRangeLastCell = .Find(What:=Criterion, After:=.Cells(1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
Set CorrespondingSubrange = Intersect(rngWorking, Range(SubRangeFirstCell, SubRangeLastCell).EntireRow)
Debug.Print CorrespondingSubrange.Address(0, 0, external:=True)
End If
End With
End Function

Excel VBA find first value row in range

I have this range it selects all values in that column:
Set c = ThisWorkbook.Worksheets("SplitSkillInterv").Range("C3:C" & Rows.Count)
Now I need to make it to find some value and then its row (it could be 1 or 10+, so I need to find first one) any ideas?
I need to find for example: in range c values are from 1 to 10 and randomly repeating till total 100 rows. I and lets say i need to find when first time will be number 3 in range and its row.
I'm also a bit unclear what you're asking, but using Find might do the trick for you:
With ThisWorkbook.Worksheets("SplitSkillInterv")
Set Rng = .Range("C3:C" & RowCount).Find(What:=".", LookIn:=xlValues, lookat:=xlPart, _
MatchCase:=False) 'find the first "." in the first row
While Not Rng Is Nothing
'Your stuff here
Set Rng = .Range("C3:C" & RowCount).Find(What:=".", LookIn:=xlValues, _
lookat:=xlPart, MatchCase:=False) 'find the next "."
Wend
End With
I would define RowCount prior to entering this code segment. Replace What:="." with whatever it is you're looking for.
Rng will then be the cell that contains whatever you're searching for. You can do your stuff to that cell at 'Your stuff here, then the next line will find the next occurrence of your search item. If you only need to do something with the first item, eliminate the rows of code after Set Rng = ...
The question is a bit unclear to me but they way I understand it this would get you the row number of the first row with the value you want to find, if you replace 'Something' with the value you want to find.
i = 3
ValueToFind = 'Something'
Do Until ValueToFind = ThisWorkbook.Worksheets("SplitSkillInterv").Cells(i, 3).Value
i = i + 1
Loop
FirstRowWithValue = i

Using VBA to populate a column based on matching values in two columns with a third columns value

The scenario is the following, I have a sheet which has two columns, one I want to match against, the other contains the values I want to copy in case of a match. I have a second sheet which contains the values to search for in the match column and the column to which to copy the value column if we have a match.
This looks like a prime candidate for VLOOKUP but I want to avoid having to hard code the column number as the data sheets contents can vary. So I Find the column based on the header's contents. If there is a way to VLOOKUP the results with this flexibility, then that also works. I can't use a formula, this needs to be in VBA.
Below there are 4 columns defined:
toFindCol: this contains the master list of values I am going to try
and find in the toMatch column
toMatchAgainstCol: this contains the list of values i want to match the toFindCol values against
valueCol: this contains the value I want to copy, in case there is a match, the value has to come from the row on which the match occurred
resultsCol: this is where i want to copy the value to, the value needs to be copied to the row of the toFind value
For some reason the code below gives a "Type Mismatch" error.
Eventually I want to wrap this into a function/subroutine so I can pass in the sheets and column headers and get it to work it's magic. Brownie points for who can do that :)
Dim toFindCol As Range
Dim toMatchAgainstCol As Range
Dim valueCol As Range
Dim resultsCol As Range
Dim match As Variant
Set toFindCol = cohortDataSetSht.Columns(1).EntireColumn
Set toMatchAgainstCol = userSht.Cells.Find("id", , xlValues, xlWhole).EntireColumn
Set valueCol = userSht.Cells.Find("cdate", , xlValues, xlWhole).EntireColumn
Set resultsCol = cohortDataSetSht.Columns(4)
For Each findMe In toFindCol
Set match = toMatchAgainstCol.Find(What:=findMe, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not match Is Nothing Then
resultsCol.Cells(findMe.Row, 0).Value = valueCol.Cells(match.Row, 0).Value
End If
Next findMe
There is a way to do this in a VLOOKUP. The basic format of the vlookup is vlookup(1,2,3,4).
I pass A2 as the top cell with the value I want to lookup. This formula can then be copied down to fill the other cells. Substitute the appropriate cell reference.
Use the Match function to find the columns you want to set your
range in. Since we only want the column letters (i.e. -"C:G"), I
strip out the number (which will always be 1 character) using the
Len function, and then use the indirect function to convert that to
a useable range, and lookup against that.
INDIRECT(LEFT(ADDRESS(1,MATCH("ToMatch",$1:$1,0),4),LEN(ADDRESS(1,MATCH("ToMatch",$1:$1,0),4))-1)&":"&LEFT(ADDRESS(1,MATCH("ValueCol",$1:$1,0),4),LEN(ADDRESS(1,MATCH("ValueCol",$1:$1,0),4))-1))
I then use the
MATCH("ValueCol",$1:$1,0)-MATCH("ToMatch",$1:$1,0)+1 to calculate
the column number of that contains the value we want to lookup in
that range.
I use 0 to indicate an exact match rather than closest value
The whole thing looks like this:
=VLOOKUP(A2,INDIRECT(LEFT(ADDRESS(1,MATCH("ToMatch",$1:$1,0),4),LEN(ADDRESS(1,MATCH("ToMatch",$1:$1,0),4))-1)&":"&LEFT(ADDRESS(1,MATCH("ValueCol",$1:$1,0),4),LEN(ADDRESS(1,MATCH("ValueCol",$1:$1,0),4))-1)),MATCH("ValueCol",$1:$1,0)-MATCH("ToMatch",$1:$1,0)+1,0)
This code assumes the column headers are in row 1. If not, replace the $1:$1 above with the absolute reference to the row your headers are in (i.e. -Row 5 would be $5:$5).
The other caveat is that we have to assume that the value you want to lookup will always be to the right of the lookup column.
Ok solved. I ended up using Rows for the toFind column:
Set toFindCol = cohortDataSetSht.Columns(1).Rows("2:" & cohortDataSetSht.Columns(1).End(xlDown).Row)
And then on the match I used the value:
Set match = toMatchAgainstCol.Cells.Find(What:=findMe.Value2, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

How to build non-consecutive ranges of rows based on cell contents?

I'm just getting started with VBA for Excel. I used VB and Java in college nearly ten years ago and was competent with it then, but am essentially starting over. (Um, not like riding a bike.)
I am trying to understand the methods to build a range that isn't just declared as A1:J34 or whatever. My Googling is challenged in that when searching for 'range' and terms that indicate what I seek, I get an avalanche of hits far more advanced than what I need, mostly hits that don't even address the basic summary info I need.
So, here's the basics of it:
Excel 2011 on Mac.
The sheet has data from A to M, down to 1309.
It's a repeating pattern of heading rows followed by data rows. Ugh. Seems like the person creating the sheet was more thinking about printing from the sheet than the organisation of the data. I need to clean it and 3 more like it up to use in a pivot table, and it's useless in this silly repeating layout.
Heading rows are as follows:
Last Name, First Name, then 10 date cells.
Data rows under the headings are the names, of course, and then a 1 or 0 for attendance.
Anywhere from 20 to 30 names under each heading. Then it repeats. And the dates change every few sets, picking up where the last set left off.
What I need to do right now:
I'm trying to assemble a range into a range variable by adding all the rows beginning with a specific value (in column A). In my case that value is the string "Last Name", so I can have the range variable holding all the cells in all rows that begin with "Last Name". This will then capture all the cells that need to be in date format. (I'm doing it so I can then make sure the date headings are all actually IN date format - because they are NOT all in date format now, many are just 'General' cells.)
My questions:
When telling a range object what it's range IS, how do you feed it cells/rows/columns that are not just a block defined by start and end cells entered by the person writing the code but based on row criteria? Eg: Create a Range that has rows 1, 34, 70, 93, and 128 from columns A to I based on presence of "First Name" in A.
What are the most common methods to do this?
Which of these is best suited to my need and why?
Here's a working example that demonstrates finding the "Last Name" rows, contructing a range object that includes all those rows, and then iterating through that object to search for non-date values. The code could be speeded up greatly by reading the data range into an array of variants and then searching the array for both the last name rows and the "bad dates" within those rows. This is especially true if you have a very large number of rows to check.
Sub DisjointRng()
Dim checkCol As String, checkPattern As String
Dim dateCols()
Dim lastCell As Range, usedRng As Range, checkRng As Range
Dim cell As Variant
Dim usedRow As Range, resultRng As Range, rngArea As Range
Dim i As Long, j As Long
checkCol = "A" 'column to check for "Last Name"
checkPattern = "Last*"
dateCols = Array(3, 5) 'columns to check for date formatting
With Worksheets("Sheet1")
'find the bottom right corner of data range; we determine the used range
'ourselves since the built-in UsedRange is sometimes out-of-synch
Set lastCell = .Cells(.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column)
Set usedRng = .Range("A1:" & lastCell.Address)
'the column of values in which to look for "Last Name"
Set checkRng = .Range(checkCol & "1:" & checkCol & usedRng.Rows.Count)
End With
'step down the column of values to check for last name & add
'add found rows to range object
For Each cell In checkRng
If cell.Value Like checkPattern Then
'create a range object for the row
Set usedRow = Intersect(cell.EntireRow, usedRng)
If resultRng Is Nothing Then
'set the first row with "Last Name"
Set resultRng = usedRow
Else
'add each additional found row to the result range object
Set resultRng = Union(resultRng, usedRow)
End If
End If
Next cell
For Each rngArea In resultRng.Areas
'if found rows are continguous, Excel consolidates them
'into single area, so need to loop through each of the rows in area
For i = 1 To rngArea.Rows.Count
For j = LBound(dateCols) To UBound(dateCols)
If Not IsDate(rngArea.Cells(i, dateCols(j))) Then
'do something
End If
Next j
Next i
Next rngArea
End Sub
You can use the Union operator, like this
Dim r As Range
Set r = Range("A1, A3, A10:A12")
or this
Set r = Union(Range("A1"), Range("A3"), Range("A10:A12"))
You can the iterate this range like this
Dim cl as Range
For Each cl in r.Cells
' code cell cl
Next
or this
Dim ar as Range
For each ar in r.Areas
' code using contiguous range ar
For each cl in ar.Cells
' code using cell cl
Next
Next