I am really new in writing Excel macros through VBA. I want to concatenate two columns in my Excel worksheet. I have data in columns A, B & C and I want to concatenate B & C column to D column. This is the code I wrote:
Sub FINAL()
'
' FINAL Macro
'
'
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D2").Select
ActiveCell.FormulaR1C1 = "SO::LI"
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-2]&""::""&RC[-1]"
Range("D3").Select
Dim lastRow As Long
lastRow = Range("C" & Rows.Count).End(xlUp).Row
Range("D3").AutoFill Destination:=Range("D3:D" & lastRow)
End Sub
This works fine. But This works only when my data is in columns A, B & C.
When the data is in different columns, such as E, F & G, this does not work.
So what I want is to find the column using column header name and concatenate data.
Style S/O L/I
392389 265146 40
558570 300285 10
558570 300285 20
After concatenation:
Style S/O L/I SO::LI
392389 265146 40 265146::40
558570 300285 10 300285::10
558570 300285 20 300285::20
You can find a column header by using the worksheet MATCH function inside VBA, here I'll put it in to a variable called c1
c1 = Application.WorksheetFunction.Match("S/O", Range("1:1"), 0)
It's best to wrap this identification in a potential error handler, because if there IS no match then you'll get a run-time error
If Application.WorksheetFunction.CountIf(Range("1:1"), "S/O") > 0 Then
c1 = Application.WorksheetFunction.Match("S/O", Range("1:1"), 0)
Else
MsgBox ("Couldn't find ""S/O"" header!")
Exit Sub
End If
Here it uses the worksheet function COUNTIF to make sure there is at least one instance of "S/O" - if there isn't then the subroutine ends.
After that, you've identified your S/O column so can carry on with the rest of the code as usual - if you assume the columns are always consecutive then you can use c1 + 1 to mean "L/I" column and c1 + 2 to mean the CONCAT column
Below is a fully working version of the code:
Private Sub CommandButton1_Click()
Dim c1 As Long
Dim lastRow As Long
' If instance of "S/O" exists then find the column number else show error message and end
If Application.WorksheetFunction.CountIf(Range("1:1"), "S/O") > 0 Then
c1 = Application.WorksheetFunction.Match("S/O", Range("1:1"), 0)
Else
MsgBox ("Couldn't find ""S/O"" header!")
Exit Sub
End If
' Get last row for formula based on the "S/O" column header in c1
lastRow = Cells(Rows.Count, c1).End(xlUp).Row
' add 2 to c1 to make the c1 variable contain column number for SO::LI
c1 = c1 + 2
' use FormulaR1C1 as usual to flood the whole column from row 2 to lastRow
Range(Cells(2, c1).Address, Cells(lastRow, c1).Address).FormulaR1C1 = "=RC[-2]&""::""&RC[-1]"
End Sub
You may give this a try...
The code will find the headers in row2 and concatenate the columns.
Sub Final()
Dim FirstCell As Range, SecondCell As Range
Dim lr As Long, r As Long, c As Long
Application.ScreenUpdating = False
'Assuming that the Row2 is the Header Row, if not change it.
Set FirstCell = Rows(2).Find("S/O")
If FirstCell Is Nothing Then
MsgBox "A column with the header S/O was not found.", vbExclamation
Exit Sub
End If
Set SecondCell = Rows(2).Find("L/I")
If SecondCell Is Nothing Then
MsgBox "A column with the header L/I was not found.", vbExclamation
Exit Sub
End If
r = FirstCell.Row + 1
c = SecondCell.Column + 1
Set FirstCell = FirstCell.Offset(1)
Set SecondCell = SecondCell.Offset(1)
lr = Cells(Rows.Count, SecondCell.Column).End(xlUp).Row
Columns(c).Insert
Range(Cells(r, c), Cells(lr, c)).Formula = "=" & FirstCell.Address(0, 0) & "&""::""&" & SecondCell.Address(0, 0) & ""
Application.ScreenUpdating = True
End Sub
Use FormulaR1C1 instead is useful
Sub mergeColumn()
Dim col As Integer
Dim tr As Long
Application.ScreenUpdating = False
On Error Resume Next
col = Rows(1).Find(What:="S/O").Column
On Error GoTo 0
If col <> 0 Then ' if not found, it goes to 0
tr = Cells(Rows.Count, col).End(xlUp).Row
Range(Cells(1, col + 2), Cells(tr, col + 2)).Value = "=RC[-2] & ""::"" & RC[-1]"
End If
Application.ScreenUpdating = True
End Sub
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 have the following VBA code:
Sub test()
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim k As Long
Dim c As Range
Dim d As Range
Dim strFA As String
Set w1 = Sheets("a")
Set w2 = Sheets("b")
w2.Cells.Clear
k = 1
With w1.Range("A:A")
Set c = .Cells.Find("Name:" After:=.Cells(.Cells.Count), lookat:=xlWhole)
strFA = ""
While Not c Is Nothing And strFA <> c.Address
If strFA = "" Then strFA = c.Address
If IsError(Application.Match(c.Offset(1, 0).value, w2.Range("A:A"), False)) Then
Set d = .Cells.Find("Birthday:", c, , xlWhole)
w2.Range("A" & k).value = c.Offset(0, 1).value
w2.Range("B" & k).value = d.Offset(1, 0).value
k = k + 1
End If
Set c = .Cells.Find("Name:", After:=c, lookat:=xlWhole)
Wend
End With
End Sub
The short version of what this code does is as follows:
1) Set the first sheet that should be searched and the second sheet (output sheet) that the results should be appended to.
2) Search the first column for a certain string "NAME:" and once found take the value in the second column, place it in the output sheet go look for "Birthday:" Once "Birthday:" is found put the value below it beside "NAME:" in the output sheet.
3) Repeat until there are no more entries.
I'm wondering how I might extend this code so that rather than searching for the value below "Birthday:" we instead search for n entries below birthday and place each one beside the value for "NAME:" in succession so that the result looks like:
Col1 Col2 Col3 Col4
James 10 15 1974
Where the input looks similar to:
Col1 Col2 Col3 Col4
Name: James
Something
Birthday:
10
15
1974
Please let me know if anything is unclear. You can assume that the three values after Birthday: always appear directly after and that James is always in the column directly beside Name: but no assumptions can be made about how far apart Name: is from Birthday:, how many blank spaces are present, and so on.
You want a loop that has an incremented index. for each row you go down you write to one column to the right. Something like this.
lRow = 4
lCol = 2
'Loop through reading the birthday.
Do While lRow <= n
'Here we are writing a column to the right each time we come through.
ws.Range(lCol & k)
lCol = lCol + 1
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
So after you have the name and you are ready to read the birthday cells. Read them like that and write them to the cells on the current row.
I have a worksheet which has many terms in Column A.I want to search for two terms for example
term A and term B and copy all rows between the two terms and paste it into a new sheet.These two terms may repeat in the column. The problem which I am basically facing the following problem : whenever I run my code it also copies rows between term B and term A which is unnecessary. Following is the code i am using for two terms term A and term B.
For example my column A is
Institute
Event
Job
Computer
Laptop
Figures
Event
figures
format
computer
and many more terms
I want to copy all the rows between term A: Event and term B: Laptop and paste it into a new sheet. What my code is doing is it is copying the rows between all combinations of Event and computer. Even the rows between computer and event are copied(in this case Figure and laptop).
Sub OpenHTMLpage_SearchIt()
Dim Cell As Range, Keyword$, N%, SearchAgain As VbMsgBoxResult
Dim ass As Variant
Dim Cellev As Range, prakash$, P%, SearchAgaina As VbMsgBoxResult
Dim asa As Variant
StartSearch:
N = 1
Keyword = "Event"
If Keyword = Empty Then GoTo StartSearch
For Each Cell In Range("A1:A500")
If Cell Like "*" & Keyword & "*" Then
ass = Cell.Address
P = 1
prakash = "Computer"
If prakash = Empty Then GoTo StartSearch
For Each Cellev In Range("A1:A500")
If Cellev Like "*" & prakash & "*" Then
asa = Cellev.Address
Range(asa, ass).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Range("B13").Select
ActiveSheet.Paste
Worksheets("sheet1").Select
P = P + 1
End If
Next Cellev
N = N + 1
End If
Next Cell
End Sub
Edit: code formatting.
The following is the code which is working for me.This copies everything in between Event and laptop and pastes it into a new sheet. Then again it searches for a second time and this time the search will start from the next row to the first search.I hope I am clear with this.
Sub Star123()
Dim rownum As Long
Dim colnum As Long
Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
rownum = 1
colnum = 1
lastrow = Worksheets("Startsheet").Range("A65536").End(xlUp).Row
With ActiveWorkbook.Worksheets("StartSheet").Range("a1:a" & lastrow)
For rownum = 1 To lastrow
Do
If .Cells(rownum, 1).Value = "Event" Then
startrow = rownum
End If
rownum = rownum + 1
If (rownum > lastrow) Then Exit For
Loop Until .Cells(rownum, 1).Value = "Laptop"
endrow = rownum
rownum = rownum + 1
Worksheets("StartSheet").Range(startrow & ":" & endrow).Copy
Sheets("Result").Select
Range("A1").Select
ActiveSheet.Paste
Next rownum
End With
End Sub
Try this:
Sub DoEeeeeet(sheetName, termA, termB)
Dim foundA As Range, _
foundB As Range
Dim newSht As Worksheet
With Sheets(sheetName).Columns(1)
Set foundA = .Find(termA)
If Not foundA Is Nothing Then
Set foundB = .Find(termB, after:=foundA, searchdirection:=xlPrevious)
End If
End With
If foundA Is Nothing Or foundB Is Nothing Then
MsgBox "Couldn't find " & IIf(foundA Is Nothing, termA, termB)
Else
Range(foundA, foundB).Copy
Set newSht = Sheets.Add
newSht.Range("B13").PasteSpecial
End If
End Sub
You can call it as follows:
DoEeeeeet "Sheet1","Event","Laptop"
It'll find the first instance of "Event" and the last instance of "Laptop" on the sheet named "Sheet1" and copy all of that data to B13 and subsequent cells in a new sheet.
Is that what you want? Or do you want each of the subranges beginning with "Event" and ending with "Laptop"?
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