I'm stuck inserting a for loop inside a For function. Essentially, the script is supposed to search for the strings in the array and then paste it in D38 and paste the value of the next string into the next cell by increments of 3 (As seen by the For x = 38 To 100 Step 3). The issue I have is that the Next x is skipping the next value of the string and the loop gets stuck. I tried inserting the For x = 38 To 100 Step 3 inside the Else statement of the first for loop but it doesn't work. What else can I do to fix this? Thank you!
strings = Array("String 1", "String 2")
For Each strng In strings
strSearch = strng
For x = 38 To 100 Step 3
Worksheets("Paste Results Here").Activate
With ActiveSheet.Columns("D:D")
Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=True)
If rFind Is Nothing Then
MsgBox ("There is no " & strSearch)
Exit Sub
Else
rFind.Activate
ActiveCell.Offset(0, 5).Resize(3, 1).Copy
Worksheets("Data").Activate
Set rng = Worksheets("Data").Cells(x, 4)
rng.Activate
ActiveCell.PasteSpecial xlValues
End If
End With
Next x
Next strng
I believe this is what you're trying to do, but let me know if it isn't. Get rid of the inner loop all together and only increment x by 3 when the string is found.
strings = Array("String 1", "String 2")
x = 38
For Each strng In strings
strSearch = strng
Worksheets("Paste Results Here").Activate
With ActiveSheet.Columns("D:D")
Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=True)
If rFind Is Nothing Then
MsgBox ("There is no " & strSearch)
Exit Sub
Else
rFind.Offset(0, 5).Resize(3, 1).Copy
Worksheets("Data").Activate
Set rng = Worksheets("Data").Cells(x, 4)
rng.PasteSpecial xlValues
x = x + 3
End If
End With
Next strng
Exit Sub bails out of the procedure scope entirely.
You don't want that - you want to bail out of the inner loop, but keep iterating to perform the next search.
Exit For will do that.
If rFind Is Nothing Then
MsgBox ("There is no " & strSearch)
Exit For
Not clear what your conditions are, but it sounds like you also want to Exit For when you do have a match. Now, if you bail out of a loop whether or not you've found what you're looking for, reconsider whether you need an inner loop at all.
Or, search for each search-string for each value of x instead of searching for each value of x for every search-string, as Scott suggested ("flip the loops"):
For x = 38 To 100 Step 3
For Each strng In strings
Set rFind = Range.Find...
If Not rFind Is Nothing Then
...paste special...
Else
...msgbox
End If
Next
Next
Use Exit For to exit a loop body, and Exit Sub to exit the procedure completely.
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)
I'm trying to set up a VBA loop function that will iterate through a number of specific sheets, conducting a single nested-loop within each sheet. The nested loop is a sumif function, and I need to store this in sumHACC until each sheet has been looped through, with the final value (sum of each sumif) to be entered into a single cell.
The nested loop is being used on its own under a different if condition (see under 'ALL OTHER FUNDERS at the bottom), but I'm struggling to nest this within the loop to iterate it across different sheets - The double loop is in 'IF HACC IS SELECTED. The name of each sheet that needs to be looped through is stored in cells D6:D19, which I pull into HACCRange, and I'm trying to loop through these sheets with:
For Each HACC In HACCRange
Set calcTab1 = Sheets(HACC)
and this is where I receive a Type mismatch error. The code in this section isn't complete (i.e. no update to sumHACC) as I'm completely bamboozled as to how to make this work!
There is technically another loop on top of this (the sumif condition moves down a list (reference)), however this doesn't seem to be the problem. Any assistance would be greatly appreciated!
Sub FunderLevel()
Dim reference As Range
Dim Funder As String
Dim itemRef1 As Range
Dim itemRef3 As Range
Dim calcTab1 As Worksheet
Dim calcTab3 As Worksheet
Dim sumCol As Range
Dim printCalc As Range
Dim HACCRange As Range
Dim QCCRange As Range
i = 21
Set reference = Range("A21:A22")
Funder = Range("A10")
'IF HACC IS SELECTED
If Funder = "HACC" Then
sumHACC = 0
Set HACCRange = Sheets("Reference Sheet").Range("D6:D19")
For Each HACC In HACCRange
Set calcTab1 = Sheets(HACC)
Set itemRef1 = calcTab1.Range("A10:A500")
myCol = calcTab1.Rows(7).Find(What:="All", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
With calcTab1
Set sumCol = calcTab1.Range(.Cells(10, myCol), .Cells(500, myCol))
End With
For Each Cell In reference
Set printCalc = Cells(i, 2)
printCalc = WorksheetFunction.SumIf(itemRef1, Cell, sumCol)
i = i + 1
Next Cell
Next HACC
'ALL OTHER FUNDERS
Else:
Set calcTab3 = Sheets(Funder)
Set itemRef3 = calcTab3.Range("A10:A500")
myCol = calcTab3.Rows(7).Find(What:="All", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Colum
With calcTab3
Set sumCol = calcTab3.Range(.Cells(10, myCol), .Cells(500, myCol))
End With
For Each Cell In reference
Set printCalc = Cells(i, 2)
printCalc = WorksheetFunction.SumIf(itemRef3, Cell, sumCol)
i = i + 1
Next Cell
End If
End Sub
Try this:
For Each HACC In HACCRange.Cells
Set calcTab1 = Sheets(HACC.value)
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
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