How to embed a 'lastrow' in a VBA code [duplicate] - vba

How can I find the last row that contains data in a specific column and on a specific sheet?

How about:
Function GetLastRow(strSheet, strColumn) As Long
Dim MyRange As Range
Set MyRange = Worksheets(strSheet).Range(strColumn & "1")
GetLastRow = Cells(Rows.Count, MyRange.Column).End(xlUp).Row
End Function
Regarding a comment, this will return the row number of the last cell even when only a single cell in the last row has data:
Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

You should use the .End(xlup) but instead of using 65536 you might want to use:
sheetvar.Rows.Count
That way it works for Excel 2007 which I believe has more than 65536 rows

Simple and quick:
Dim lastRow as long
Range("A1").select
lastRow = Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row
Example use:
cells(lastRow,1)="Ultima Linha, Last Row. Youpi!!!!"
'or
Range("A" & lastRow).Value = "FIM, THE END"

function LastRowIndex(byval w as worksheet, byval col as variant) as long
dim r as range
set r = application.intersect(w.usedrange, w.columns(col))
if not r is nothing then
set r = r.cells(r.cells.count)
if isempty(r.value) then
LastRowIndex = r.end(xlup).row
else
LastRowIndex = r.row
end if
end if
end function
Usage:
? LastRowIndex(ActiveSheet, 5)
? LastRowIndex(ActiveSheet, "AI")

Public Function LastData(rCol As Range) As Range
Set LastData = rCol.Find("*", rCol.Cells(1), , , , xlPrevious)
End Function
Usage: ?lastdata(activecell.EntireColumn).Address

All the solutions relying on built-in behaviors (like .Find and .End) have limitations that are not well-documented (see my other answer for details).
I needed something that:
Finds the last non-empty cell (i.e. that has any formula or value, even if it's an empty string) in a specific column
Relies on primitives with well-defined behavior
Works reliably with autofilters and user modifications
Runs as fast as possible on 10,000 rows (to be run in a Worksheet_Change handler without feeling sluggish)
...with performance not falling off a cliff with accidental data or formatting put at the very end of the sheet (at ~1M rows)
The solution below:
Uses UsedRange to find the upper bound for the row number (to make the search for the true "last row" fast in the common case where it's close to the end of the used range);
Goes backwards to find the row with data in the given column;
...using VBA arrays to avoid accessing each row individually (in case there are many rows in the UsedRange we need to skip)
(No tests, sorry)
' Returns the 1-based row number of the last row having a non-empty value in the given column (0 if the whole column is empty)
Private Function getLastNonblankRowInColumn(ws As Worksheet, colNo As Integer) As Long
' Force Excel to recalculate the "last cell" (the one you land on after CTRL+END) / "used range"
' and get the index of the row containing the "last cell". This is reasonably fast (~1 ms/10000 rows of a used range)
Dim lastRow As Long: lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row - 1 ' 0-based
' Since the "last cell" is not necessarily the one we're looking for (it may be in a different column, have some
' formatting applied but no value, etc), we loop backward from the last row towards the top of the sheet).
Dim wholeRng As Range: Set wholeRng = ws.Columns(colNo)
' Since accessing cells one by one is slower than reading a block of cells into a VBA array and looping through the array,
' we process in chunks of increasing size, starting with 1 cell and doubling the size on each iteration, until MAX_CHUNK_SIZE is reached.
' In pathological cases where Excel thinks all the ~1M rows are in the used range, this will take around 100ms.
' Yet in a normal case where one of the few last rows contains the cell we're looking for, we don't read too many cells.
Const MAX_CHUNK_SIZE = 2 ^ 10 ' (using large chunks gives no performance advantage, but uses more memory)
Dim chunkSize As Long: chunkSize = 1
Dim startOffset As Long: startOffset = lastRow + 1 ' 0-based
Do ' Loop invariant: startOffset>=0 and all rows after startOffset are blank (i.e. wholeRng.Rows(i+1) for i>=startOffset)
startOffset = IIf(startOffset - chunkSize >= 0, startOffset - chunkSize, 0)
' Fill `vals(1 To chunkSize, 1 To 1)` with column's rows indexed `[startOffset+1 .. startOffset+chunkSize]` (1-based, inclusive)
Dim chunkRng As Range: Set chunkRng = wholeRng.Resize(chunkSize).Offset(startOffset)
Dim vals() As Variant
If chunkSize > 1 Then
vals = chunkRng.Value2
Else ' reading a 1-cell range requires special handling <http://www.cpearson.com/excel/ArraysAndRanges.aspx>
ReDim vals(1 To 1, 1 To 1)
vals(1, 1) = chunkRng.Value2
End If
Dim i As Long
For i = UBound(vals, 1) To LBound(vals, 1) Step -1
If Not IsEmpty(vals(i, 1)) Then
getLastNonblankRowInColumn = startOffset + i
Exit Function
End If
Next i
If chunkSize < MAX_CHUNK_SIZE Then chunkSize = chunkSize * 2
Loop While startOffset > 0
getLastNonblankRowInColumn = 0
End Function

Here's a solution for finding the last row, last column, or last cell. It addresses the A1 R1C1 Reference Style dilemma for the column it finds. Wish I could give credit, but can't find/remember where I got it from, so "Thanks!" to whoever it was that posted the original code somewhere out there.
Sub Macro1
Sheets("Sheet1").Select
MsgBox "The last row found is: " & Last(1, ActiveSheet.Cells)
MsgBox "The last column (R1C1) found is: " & Last(2, ActiveSheet.Cells)
MsgBox "The last cell found is: " & Last(3, ActiveSheet.Cells)
MsgBox "The last column (A1) found is: " & Last(4, ActiveSheet.Cells)
End Sub
Function Last(choice As Integer, rng As Range)
' 1 = last row
' 2 = last column (R1C1)
' 3 = last cell
' 4 = last column (A1)
Dim lrw As Long
Dim lcol As Integer
Select Case choice
Case 1:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Case 2:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Case 3:
On Error Resume Next
lrw = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lcol = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Last = Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
Case 4:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Last = R1C1converter("R1C" & Last, 1)
For i = 1 To Len(Last)
s = Mid(Last, i, 1)
If Not s Like "#" Then s1 = s1 & s
Next i
Last = s1
End Select
End Function
Function R1C1converter(Address As String, Optional R1C1_output As Integer, Optional RefCell As Range) As String
'Converts input address to either A1 or R1C1 style reference relative to RefCell
'If R1C1_output is xlR1C1, then result is R1C1 style reference.
'If R1C1_output is xlA1 (or missing), then return A1 style reference.
'If RefCell is missing, then the address is relative to the active cell
'If there is an error in conversion, the function returns the input Address string
Dim x As Variant
If RefCell Is Nothing Then Set RefCell = ActiveCell
If R1C1_output = xlR1C1 Then
x = Application.ConvertFormula(Address, xlA1, xlR1C1, , RefCell) 'Convert A1 to R1C1
Else
x = Application.ConvertFormula(Address, xlR1C1, xlA1, , RefCell) 'Convert R1C1 to A1
End If
If IsError(x) Then
R1C1converter = Address
Else
'If input address is A1 reference and A1 is requested output, then Application.ConvertFormula
'surrounds the address in single quotes.
If Right(x, 1) = "'" Then
R1C1converter = Mid(x, 2, Len(x) - 2)
Else
x = Application.Substitute(x, "$", "")
R1C1converter = x
End If
End If
End Function

I would like to add one more reliable way using UsedRange to find the last used row:
lastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
Similarly to find the last used column you can see this
Result in Immediate Window:
?Sheet1.UsedRange.Row+Sheet1.UsedRange.Rows.Count-1
21

Public Function GetLastRow(ByVal SheetName As String) As Integer
Dim sht As Worksheet
Dim FirstUsedRow As Integer 'the first row of UsedRange
Dim UsedRows As Integer ' number of rows used
Set sht = Sheets(SheetName)
''UsedRange.Rows.Count for the empty sheet is 1
UsedRows = sht.UsedRange.Rows.Count
FirstUsedRow = sht.UsedRange.Row
GetLastRow = FirstUsedRow + UsedRows - 1
Set sht = Nothing
End Function
sheet.UsedRange.Rows.Count: retrurn number of rows used, not include empty row above the first row used
if row 1 is empty, and the last used row is 10, UsedRange.Rows.Count will return 9, not 10.
This function calculate the first row number of UsedRange plus number of UsedRange rows.

Last_Row = Range("A1").End(xlDown).Row
Just to verify, let's say you want to print the row number of the last row with the data in cell C1.
Range("C1").Select
Last_Row = Range("A1").End(xlDown).Row
ActiveCell.FormulaR1C1 = Last_Row

get last non-empty row using binary search
returns correct value event though there are hidden values
may returns incorrect value if there are empty cells before last non-empty cells (e.g. row 5 is empty, but row 10 is last non-empty row)
Function getLastRow(col As String, ws As Worksheet) As Long
Dim lastNonEmptyRow As Long
lastNonEmptyRow = 1
Dim lastEmptyRow As Long
lastEmptyRow = ws.Rows.Count + 1
Dim nextTestedRow As Long
Do While (lastEmptyRow - lastNonEmptyRow > 1)
nextTestedRow = Application.WorksheetFunction.Ceiling _
(lastNonEmptyRow + (lastEmptyRow - lastNonEmptyRow) / 2, 1)
If (IsEmpty(ws.Range(col & nextTestedRow))) Then
lastEmptyRow = nextTestedRow
Else
lastNonEmptyRow = nextTestedRow
End If
Loop
getLastRow = lastNonEmptyRow
End Function

Function LastRow(rng As Range) As Long
Dim iRowN As Long
Dim iRowI As Long
Dim iColN As Integer
Dim iColI As Integer
iRowN = 0
iColN = rng.Columns.count
For iColI = 1 To iColN
iRowI = rng.Columns(iColI).Offset(65536 - rng.Row, 0).End(xlUp).Row
If iRowI > iRowN Then iRowN = iRowI
Next
LastRow = iRowN
End Function

Sub test()
MsgBox Worksheets("sheet_name").Range("A65536").End(xlUp).Row
End Sub
This is looking for a value in column A because of "A65536".

The first line moves the cursor to the last non-empty row in the column. The second line prints that columns row.
Selection.End(xlDown).Select
MsgBox(ActiveCell.Row)

Related

Excel VBA macro for one column, if true, apply formula to another column

For context:
I would like for the program to look through column B, identify the first "< / >" (which is purely stylistic and can be changed if necessary - it's only used to break up the data) as the start of a week at cell B9 and the next "< / >" (end of the week) at B16. So the range I'm interested in is B10-B15. It would then sum those numbers from J10 to J15 (Earned column) and paste that sum in L16 (Week Total column). The same could then be done with 'Hours' and 'Week Hours'. For the following week (and thereafter) the 'end of the week' "< / >" becomes the start of the week, and the program continues until B200.
I don't have any experience with VBA and so made the following incomplete attempt (based on what I had found online) but felt too out of my depth not to ask for help.
Sub Work()
Dim rng As Range
Dim rngFound As Range
Set rng = Range("B:B")
Set rngFound = rng.Find("</>")
If rngFound Is "</>" Then
If Cell = "</>" Then
End If
End Sub
Thank you for any help and please let me know if I can be clearer or elaborate on something.
The following code will loop through 200 lines, looking for your symbol. When found, it will sum the numbers in column J for rows between the current row and the last symbol.
I've included two lines that will update the formula. To me, the 2nd one is easier to understand.
Sub Work()
Dim row As Integer
row = 4
Dim topRowToAdd As Integer 'Remember which row is the
'top of the next sum
topRowToAdd = 4
While row <= 200
If Cells(row, 2) = "</>" Then
'Cells(row, 10).FormulaR1C1 = "=SUM(R[" & -(row - topRowToAdd) & "]C[0]:R[" & -1 & "]C[0])"
Cells(row, 10).Value = "=SUM(J" & topRowToAdd & ":J" & row - 1 & ")"
topRowToAdd = row + 1
End If
row = row + 1
Wend
End Sub
Sub Work()
Dim rng As Range, rngFound As Range
Set rng = Range("B:B")
Set rngFound = rng.Find("</>")
If rngFound.Value2 = "</>" Then
'whatever you want to do
End If
End Sub
So at a second glance it looks like this. If you'd like to make it structured you'd need to use a countifs function first.
Sub Work()
Dim rng As Range, rngFound(1) As Range
Set rng = Range("B1:B200")
On Error GoTo Err 'it is quite possible it will run into an error if there are no matches and I'm too lazy for structured solution
Set rngFound(0) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext) 'finds the first
Set rngFound(1) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext, After:=rngFound(0)) 'finds the first after the first (i.e. the second)
Set rngFound(0) = rngFound(0).Offset(1, 8) '8 is the difference between B and J, row shifts as per description, I advise you to make it a variable
Set rngFound(1) = rngFound(1).Offset(-1, 8)
If rngFound(1).Row > rngFound(0).Row Then 'if it's not higher, then it recurred and found the first range again
rngFound(1).Offset(1, 2).Formula = "=SUM(" & Range(rngFound(0), rngFound(1)).Address & ")" 'L column will have the sum as a formula
Else
MsgBox "There is a single match in " & rng.Address(False, False)
End If
If False Then
Err:
MsgBox "There are no matches in " & rng.Address(False, False)
End If
End Sub
Now for the grand finale:
Sub Work()
Dim rng As Range, rngFound() As Range, rngdiff(1) As Long, rngcount As Long
Set rng = Range("B1:B200")
rngcount = rng.Cells.Count
ReDim rngFound(rngcount)
rngdiff(0) = Range("J1").Column - rng.Column ' the range that needs to be summed is in column J
rngdiff(1) = Range("L1").Column - rng.Column ' the range containing the formula is in column L
On Error GoTo Err 'it is quite possible it will run into an error if there are no matches and I'm too lazy for structured solution
Set rngFound(0) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext) 'finds the first
'loop starts
For i = 1 To rngcount
Set rngFound(i) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext, After:=rngFound(i - 1)) 'finds the next
If rngFound(i).Row > rngFound(i - 1).Row Then 'if it's not higher, then it recurred and found the first range again
rngFound(i).Offset(0, rngdiff(1)).Formula = "=SUM(" & Range(rngFound(i - 1).Offset(1, rngdiff(0)), rngFound(i).Offset(-1, rngdiff(0))).Address & ")" 'L column will have the sum as a formula
Else
Exit Sub 'if it recurred the deed is done
End If
Next i
If False Then
Err:
MsgBox "There are no matches in " & rng.Address(False, False)
End If
End Sub

Need to determine LastRow over the Whole Row

I am not a programmer but have managed to cobble together great amounts of code that work on 4 pretty large projects (Yay for me!) I have tried numerous ways to find the Last Row. Some work for me some don't. I can find a few that give me the "actual" last row regardless of blanks in Column A (this is what I need). Yet I CANNOT for my life figure how to integrate that code with the way I am passing values from my array from one workbook to another. All of the code works "As Is" but I need to find a better way of searching the whole row (currently columns A:O) for the Last Row and then copying the data over. Column A maybe empty at times and to avoid the code from being overwritten, that "Last Row" needs to check the whole row. I am currently forcing a hidden cell (A7) with a "." as a forced placeholder. Any advice would be awesome.
Option Explicit
Public Sub SaveToLog15()
Dim rng As Range, aCell As Range
Dim MyAr() As Variant
Dim n As Long, i As Long
Dim LastRow As Long
Dim NextCell As Range
Dim Sheet2 As Worksheet
Set Sheet2 = ActiveSheet
Application.ScreenUpdating = False
With Sheet2
' rng are the cells you want to read into the array.
' Cell A7 (".") is a needed "Forced Place Holder" for last row _
determination
' A7 will go away once "better" LastRow can be added to this code
Set rng = Worksheets("Main").Range("A7,D22,D19,D20,J22:J24,E23,D21,J25:J27,D62,D63,G51")
' counts number of cells in MyAr
n = rng.Cells.Count
' Redimensions array for above range
ReDim MyAr(1 To n)
' Sets start cell at 1 or "A"
n = 1
' Loops through cells to add data to the array
For Each aCell In rng.Cells
MyAr(n) = aCell.Value
n = n + 1
Next aCell
End With
On Error Resume Next
' Opens "Test Log.xls"
Workbooks.Open FileName:= _
"S:\Test Folder\Test Log.xls"
' SUBROUTINE 1 "Disable Sheet Protection and Show All" REMOVED
' Finds last row on Tab "Tracking" based on Column "A"
' Last row determination DOES NOT go to next row if first _
Column is blank
' Use A7 "." to always force Data to Col A
'**********************************************************************
'THIS WORKS FINE BUT DOES NOT RECOGNIZE THE POSSIBLE BLANK IN COL A.
With Worksheets("Incoming Data")
Set NextCell = Worksheets("Incoming Data").Cells _
(Worksheets("Incoming Data").Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
' I need this code replaced by the following code or integrated into
' this code snippet. I am lost on how to make that happen.
'***********************************************************************
'***********************************************************************
'THIS CODE FINDS THE "ACTUAL" LAST ROW AND THIS IS WHAT I'D LIKE TO USE
' I need to figure how to integrate this code block with the above
' Or maybe redo the whole thing.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox ("The Last Row Is: " & LastRow)
' I am not using this code in the program. It's just there to show
' what I need to use because it works. I need to make this code work
'WITH the above block.
'***********************************************************************
' Sets the size of the new array and copies MyAr to it
NextCell.Resize(1, UBound(MyAr)).Value = (MyAr)
' SUBROUTINE 2 "Add borders to cells in range" REMOVED
' SUBROUTINE 3 "Re-enable Sheet Protection" REMOVED
ActiveWorkbook.Save
'ActiveWindow.Close
Application.ScreenUpdating = True
MsgBox "Your Data has been saved to the Log File: " & vbCrLf & vbCrLf _
& "'Test Log.xls'", vbInformation, "Log Save Confirmation"
End Sub
This is a common problem with "jagged" data like:
Clearly here column B has that last row. Here is one way to get that overall Last row by looping over the four candidate columns:
Sub RealLast()
Dim m As Long
m = 0
For i = 1 To 4
candidate = Cells(Rows.Count, i).End(xlUp).Row
If candidate > m Then m = candidate
Next i
MsgBox m
End Sub
:
Find works best for most situations, below is the function i use that takes sheet ref as input and returns row number as type Long
Dim lLastRow As Long
lLastRow = LastUsedRow(shName)
Private Function LastUsedRow(sh As Worksheet) As Long
LastUsedRow = sh.Cells.Find(What:="*", After:=sh.Cells.Cells(1), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
End Function
The simplest thing might be to use the specialcells method, as in range.specialcells(xllastcell). This returns the cell whose row number is the last row used anywhere in the spreadsheet, and whose column is the last column used anywhere in the worksheet. (I don't think it matters what "range" you specify; the result is always the last cell on the worksheet.)
So if you have data in cells B30 and X5 and nowhere else, cells.specialcells(xllastcell) will point to cell X30 (and range("A1").specialcells(xlastcell) will also point to cell X30).
Instead of:
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox ("The Last Row Is: " & LastRow)
use this:
LastRow = cells.specialcells(xllastcell).row
MsgBox ("The Last Row Is: " & LastRow)
After 35 attempts this is the code that I was able to hack into my original:
' Used to determine LastRow, LastColumn, LastCell, NextCell
Dim LastRow As Long
Dim LastColumn As Integer
Dim LastCell As Range, NextCell As Range
With Worksheets("Tracking")
' Find LastRow. Works Best. 1st and last cells can be empty
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'MsgBox "Last Cell" & vbCrLf & vbCrLf & Cells(LastRow, LastColumn).Address
'MsgBox "The Last Row is: " & vbCrLf & vbCrLf & LastRow
'MsgBox "The Last Column is: " & vbCrLf & vbCrLf & LastColumn
End If
' Number of columns based on actual size of log range NOT MyAr(n)
Set NextCell = Worksheets("Tracking").Cells(LastRow + 1, (LastColumn - 10))
End With
This finds the "Real" Last Row and column and ignores any empty cells in Column A or J which seem to affect some of the LastRow snippets. I needed to make it ROWS instead of ROW and HAD the add the Offset portion as well. (-10) puts me back to Column "A" for my sheet and now I have removed Column "A" {the forced Place Holder "."} and have "Real" data there now. YAY for the "Hacking Code Cobbler".
Glad they pay me at work to learn this stuff. :) Solved this a while back. Just now got to update this post.

How to locate all '0' on fixed row and varying Columns, then sum them up?

I need help with my code, I'm not sure why it isnt running properly and takes a very long time. What i'm trying to do is to locate repeated temp, for example, 0. After locating 0, I will continue to look for any more 0 at the temp row, if there is i will sum the test1 of B3 and test1 of H3 together... it will continue until the end of the row and will be pasted at Column N or O which is an empty column. After that, will have to do the same for 100, overall.
The resultant should be like this
I have trouble running the following code that i tried writing.
Dim temprow As Long, ColMax1 As Long, tempcell As Range, ColCount1 As Long
Dim temprow1 As Long, valuetohighlight As Variant, valuetohighlight1 As Variant
Dim totalvalue As Double, findvalues As Long
temprow = 1
ColMax1 = 10
Do
Set tempcell = Sheets("Sheet1").Cells(temprow, 1)
'Look for the word temp in column A
If tempcell = "temp" Then
'Look for values = 0
For ColCount1 = 2 To ColMax1
findvalues = Sheets("Sheet1").Cells(temprow, ColCount1)
If findvalues = 0 Then
temprow1 = temprow + 1
valuetohighlight = Sheets("Sheet1").Cells(temprow1, ColCount1)
End If
Next
'Look for other values that is equal to 0
For ColCount1 = 3 To ColMax1
findvalues = Sheets("Sheet1").Cells(temprow, ColCount1)
If findvalues = 0 Then
temprow1 = temprow + 1
valuetohighlight1 = Sheets("Sheet1").Cells(temprow1, ColCount1)
End If
Next
temprow = temprow + 1
End If
Loop
For ColCount1 = 1 To ColMax1
If Sheets("Sheet1").Cells(temprow, ColCount1) = "" Then
totalvalue = 0
totalvalue = valuetohighlight + valuetohighlight1
End If
Next
End Sub
If you have any ideas or opinion, do share it with me.. will appreciate your help!
Slight Modifications
Now need also to consider the name.
What you want to achieve can be done with a formula. The trick is to keep the Cell Headers in Col O to Q in Row 2 to actual values that you want to compare.
Formula in Cell O3
=SUMPRODUCT(($B$2:$M$2=$O$2)*B3:M3)
Snapshot
FOLLOW UP
Hi, i remember u using that formula and typed it into a VBA for me before, i have tried and it work.. Sheets("Sheet1").[O5] = Evaluate("SUMPRODUCT((B2:M2=O2)*(B5:M5))") but, i cant really have a fixed column for the printed result and also the temp may not falls on Row 2...
Here is a sample code. Change 15 to the relevant column where you want to display the result. I have commented the code so you shouldn't have any problem in understanding the code. If you still do then simply ask :)
CODE
Option Explicit
Sub Sample()
Dim ColNo As Long, tempRow As Long
Dim ws As Worksheet
Dim aCell As Range
'~~> Change this to the column number where you want to display the result
'~~> The code assumes that Row 2 in this column has headers
'~~> for which you want to retrieve values
ColNo = 18 '<~~ Example :- Column R
'~~> Change this to relevant sheet name
Set ws = Sheets("Sheet1")
'~~> Get the row number which has "Temp"
Set aCell = ws.Columns(1).Find(What:="Temp", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'~~> This is the row which has 'Temp'
tempRow = aCell.Row
'~~> Sample for putting the value in Row 3 (assuming that 'temp' is not in row 3)
'~~> SNAPSHOT 1
ws.Cells(3, ColNo).Value = Evaluate("=SUMPRODUCT(($B$" & tempRow & ":$M$" & tempRow & "=" & _
ws.Cells(2, ColNo).Address & ")*(B3:M3))")
'~~> If you want to use formula in the cell in lieu of values then uncomment the below
'~~> SNAPSHOT 2
'ws.Cells(3, ColNo).Formula = "=SUMPRODUCT(($B$" & tempRow & ":$M$" & tempRow & "=" & _
ws.Cells(2, ColNo).Address & ")*(B3:M3))"
Else
MsgBox "Temp Not Found. Exiting sub"
End If
End Sub
SNAPSHOT (IF YOU USE EVALUATE IN THE ABOVE CODE)
SNAPSHOT (IF YOU USE .FORMULA IN THE ABOVE CODE)
HTH
Sid

Next Without For error in nested loop in Excel VBA

I am trying to figure out a way to run a Vlookup on a Cell in my "System File" by checking a table in a "New Data" File. HOWEVER, if there is an #N/A error, I want the cells' values to be unchanged. I've come up with the following, however, I keep getting a "Next without For" error. Is it possible to escape a nested For Next loop?
The tl;dr semantic version:
For i 1 to 10
For j 1 to 3
Something with .Cells(i,j)
Set range X = .Find(thing
If X = Nothing Then
Next j *** <THIS IS WHERE MY ERROR IS THROWN
Else
-Do Something with X-
End if
Next j
Next i
My more or less actual code is as follows:
Sub Thing()
Dim SysWS As Worksheet
Dim NewDataWS As Worksheet
Dim NDSKUs As Range ' This is set to the first column of the NewDataWS
Dim NDMonthsRow As Range ' This is set to the first row of the NewDataWS
Dim SKU2look4 As String, Month2look4 As String
Dim ifoundtheSKU As Range 'the result of finding SKU2look4 inside of NDSKUs range
Dim ifoundtheDate As Range 'the result of finding Month2look4 inside of NDMonthsRow range
Dim i As Integer, j As Integer
Dim workzone As Range 'The Cell being evaluated
For i = 2 To SysWS.UsedRange.Columns.Count
For j = 2 To SysWS.UsedRange.Rows.Count
Set workzone = SysWS.Cells(j, i)
SKU2look4 = SysWS.Cells(j, 1) 'SKUs are along the left column
Month2look4 = SysWS.Cells(1, i) 'Dates are along the top row
'1-Find the right Date Column for extraction
Set ifoundtheDate = NDMonthsRow.Find(What:=Month2look4, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If ifoundtheDate Is Nothing Then
Debug.Print (Month2look4 & " -Date NOT Found in New Date File")
******Next j******
Else
Debug.Print ("ifoundtheDate:" & ifoundtheDate.Address)
End If
'2-Find the row
Set ifoundtheSKU = NDSKUs.Find(What:=SKU2look4, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If ifoundtheSKU Is Nothing Then
Debug.Print (SKU2look4 & " Not Found in the New Data File")
*********Next j******
Else
Debug.Print ("ifoundtheSKU:" & ifoundtheSKU.Address)
End If
'Set the "workzone" cell's value to that of the found row offset by the found column
workzone = ifoundtheSKU.Offset(, (ifoundtheDate.Column - 1))
Next j
Next i
Of course the ***s are not actually in there. Any thoughts on how I can accomplish this?
Thanks in advance
For i = 1 to 10
For j = 1 to 3
Something with .Cells(i,j)
Set rngX = .Find(thing)
If Not rngX Is Nothing Then
Set rngY = .Find(thingelse)
If Not rngY Is Nothing Then
'something with rngX and rngY
End If
End if
Next j
Next i
Use
For i=1 to 10
For j=1 to 3
Something with .Cells(i,j)
Set range X = .Find(thing
If X = Nothing Then
Goto Nextj *** <THIS IS WHERE MY ERROR IS THROWN
Else
-Do Something with X-
End if
NextJ:
Next j
Next i
Exit For terminates the current for loop early (the inner one in your case).

=MATCH() equivalent for multidimensional ranges

I have an excel sheet, where cells A1-C20==INT(RAND()*10). This is my data range. Cell E1=1, E2=2, E3=3, etc. These are the values I am trying to find. I set cell F1==MATCH(E1,A:C,0), F2==MATCH(E1,A:C,0), etc.
However, all the MATCH functions return #N/A, because the input range is multi-dimensional. How can I test whether a given value (1, 2, 3, 4, etc.) exists in a multidimensional range (A1-C20)?
/edit: This function works, but is more than I need. Is there any way to make it return just TRUE or FALSE, depending on if the lookup value is in the range?
Function OzgridLookup(Find_Val As Variant, Occurrence As Long, Table_Range As Range, _
Offset_Cols As Long, Optional Column_Lookin As Long, Optional Row_Offset As Long) As Variant
Dim lLoop As Long
Dim FoundCell As Range
If Column_Lookin = 0 Then 'No column # specified
With Table_Range
'Top left cell has Find_Val & Occurrence is 1
If Table_Range.Cells(1, 1) = Find_Val And Occurrence = 1 Then
OzgridLookup = .Cells(1, 1)(1, Offset_Cols + 1)
Exit Function 'All done :)
Else 'No column # specified so search all for _
nth Occurrence reading left to right
Set FoundCell = .Cells(1, 1) 'Set cell variable for Find start
For lLoop = 1 To Occurrence 'Loop as many times as Occurrences _
and each time Set "FoundCell" to start next Find from
Set FoundCell = _
Table_Range.Find(What:=Find_Val, After:=FoundCell, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlRows, SearchDirection:=xlNext)
Next lLoop
End If
End With
Else 'column # specified
With Table_Range.Columns(Column_Lookin) 'Work with column # specified
Set FoundCell = .Cells(1, 1) 'Set cell variable for Find start
For lLoop = 1 To Occurrence 'Loop as many times as Occurrences _
and each time Set "FoundCell" to start next Find from
Set FoundCell = _
Table_Range.Find(What:=Find_Val, After:=FoundCell, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlRows, SearchDirection:=xlNext)
Next lLoop
End With
End If
OzgridLookup = FoundCell.Offset(Row_Offset, Offset_Cols)
End Function
You can use COUNTIF to do this since you only want to know whether the number is present (not its location).
=COUNTIF(A:C,E1)>0
This will return "TRUE" if it is present, "FALSE" if it is not.
Just for fun, here's a worksheet function solution that returns the cell address that matches the lookup value. It uses the fact that you are only searching in 3 columns.
=IF(ISERROR(MATCH(E1,A:A,0)),IF(ISERROR(MATCH(E1,B:B,0)),IF(ISERROR(MATCH(E1,C:C,0)),"Not found.","C"&MATCH(E1,C:C,0)),"B"&MATCH(E1,B:B,0)),"A"&MATCH(E1,A:A,0))
I thought I'd also throw in a VBA solution that can return the match location inside a (contiguous) range. It looks at columns one at a time from left to right and returns the address of the first match found.
Public Function MDMATCH(srchfor As String, lookin As Range) As String
Application.Volatile
Dim RngArray() As Variant
Dim topleft As String
Dim tmpval As String
topleft = lookin.Address
topleft = Left(topleft, InStr(topleft, ":") - 1)
tmpval = "Not found."
RngArray = lookin
For i = 1 To UBound(RngArray, 2)
If tmpval = "Not found." Then
For j = 1 To UBound(RngArray, 1)
If RngArray(j, i) = srchfor Then
tmpval = Range(topleft).Offset(j - 1, i - 1).Address
Exit For
End If
Next j
Else
Exit For
End If
Next i
MDMATCH = tmpval
End Function