To retrieve the particular cell value

Solved/Closed
Report
-
Posts
30
Registration date
Sunday August 9, 2009
Status
Member
Last seen
April 20, 2010
-
Hello,
Can you please provide me with a macro VBA code
In "Sheet1" i have values in 'A' and 'B' columns.
Sheet1:
A B
1 Name $10.00
2 Apple $20.00
3 Orange $30.00
Am trying to search in 'B1' cell of "Sheet2" for the values entered in 'A' column of "Sheet1".if search is true, the values of column A and B should be displayed in the sheet2.
Eg: Suppose i try to search for the name "Apple" from sheet2, it should search in sheet1 and if true, it should retrieve the name and amount from sheet1 and display it in the Sheet2
Sheet2
A B
1 Apple $20.00

4 replies

Posts
30
Registration date
Sunday August 9, 2009
Status
Member
Last seen
April 20, 2010
12
Additional Ucase........

Sub TEST()
Dim i, j As Integer
Dim ValName As String
i = 2
j = 2
ValName = Sheets("Sheet2").Cells(1, 2)
Sheets("SHEET2").Range("A:b").ClearContents
Sheets("Sheet2").Cells(1, 1) = "PRODUCT"
Sheets("Sheet2").Cells(1, 2) = ValName

Do Until Sheets("sheet1").Cells(i, 1) = "" Or Sheets("sheet1").Cells(i, 1) = Null
If UCase(ValName) = UCase(Sheets("Sheet1").Cells(i, 1)) Then
Sheets("Sheet2").Cells(j, 1) = Sheets("Sheet1").Cells(i, 1)
Sheets("Sheet2").Cells(j, 2) = Sheets("Sheet1").Cells(i, 2)
j = j + 1
End If
i = i + 1
Loop

End Sub
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2821 users have said thank you to us this month

Hey Thanks!!! I works perfect with Ucase :)
Posts
30
Registration date
Sunday August 9, 2009
Status
Member
Last seen
April 20, 2010
12
try this....

Sub TEST()
Dim i, j As Integer
Dim ValName As String
i = 2
j = 2
ValName = Sheets("Sheet2").Cells(1, 2)
Sheets("SHEET2").Range("A:b").ClearContents
Sheets("Sheet2").Cells(1, 1) = "PRODUCT"
Sheets("Sheet2").Cells(1, 2) = ValName

Do Until Sheets("sheet1").Cells(i, 1) = "" Or Sheets("sheet1").Cells(i, 1) = Null
If ValName = Sheets("Sheet1").Cells(i, 1) Then
Sheets("Sheet2").Cells(j, 1) = Sheets("Sheet1").Cells(i, 1)
Sheets("Sheet2").Cells(j, 2) = Sheets("Sheet1").Cells(i, 2)
j = j + 1
End If
i = i + 1
Loop

End Sub

Best regards,
Kaiyasit Phanmakorn
kaiyasitp@gmail.com
hi Kaiyasit,
I tried with Find method. Pls refer the code below...
Am not able to get the respective amount from 'D' column of sheet1("Data") for the description matched in 'C' column of sheet1("Data"). In sheet2("Result"), description is displayed properly but the corresponding amount for the matched description does not display.. Please help me out :(

On Error Resume Next
Set WB = ActiveWorkbook
If Err = 0 Then
On Error GoTo 0
For Each WS In WB.Worksheets
'Omit results page from search
'If WS.Name <> "Result" Then
If WS.Name = "Data" Then
With WB.Sheets(WS.Name).Cells
Set Cell = .Find(What:=Search, after:=.SpecialCells(xlCellTypeLastCell), LookIn:=xlValues, LookAt:=xlPart, _
MatchCase:=False, SearchOrder:=xlByColumns)

If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
Counter = Counter + 1

ReDim Preserve FindCell(1 To Counter)
ReDim Preserve FindSheet(1 To Counter)
ReDim Preserve FindWorkBook(1 To Counter)
ReDim Preserve FindPath(1 To Counter)
ReDim Preserve FindText(1 To Counter)
ReDim Preserve FindAmount(1 To Counter)
FindCell(Counter) = Cell.Address(False, False)
' MsgBox FindCell(Counter)
FindText(Counter) = Cell.Text
' FindAmount(Counter) = Worksheets("Data").Range("D3:D1000").Cells(Counter, 1).Value
FindCell(Counter) = Cell.Address(False, False)
' MsgBox FindCell(Counter)
FindAmount(Counter) = Cell(counter,2).Value
' MsgBox FindAmount (Counter)

FindSheet(Counter) = WS.Name
FindWorkBook(Counter) = WB.Name
FindPath(Counter) = WB.FullName
Set Cell = .FindNext(Cell)
Loop While Not Cell Is Nothing And Cell.Address <> FirstAddress
End If
End With
End If
Next
End If
Posts
30
Registration date
Sunday August 9, 2009
Status
Member
Last seen
April 20, 2010
12
It's may be not good code.....
Please try......and feed back


Private Sub AMOUNT_()
On Error GoTo AMOUNT_Error
Dim Desc() As String
Dim Amount() As Long
Dim i, j, jj, jjj, k, m, l As Integer

Sheets("Result").Cells(1, 1) = "DESC"
Sheets("Result").Cells(1, 2) = "AMOUNT_"
i = 2
'Count row
Do Until Sheets("Data").Cells(i, 3) = "" Or Sheets("Data").Cells(i, 3) = Null
i = i + 1
Loop


ReDim Desc(2 To i)
ReDim Amount(2 To i)


jjj = 2

'get Desc type
For j = 2 To i
For jj = 2 To i
If Sheets("Data").Cells(j, 3) = Desc(jj) Or IsNull(Sheets("Data").Cells(j, 3)) Or Sheets("Data").Cells(j, 3) = "" Then GoTo Jum1
Next jj

Desc(jjj) = Sheets("Data").Cells(j, 3)
jjj = jjj + 1

Jum1:
Next j

'Sum Data
For m = 2 To jjj - 1
For k = 2 To i
If Desc(m) = Sheets("Data").Cells(k, 3) Then
Amount(m) = Amount(m) + Val(Sheets("Data").Cells(k, 4))
End If
Next k
'show Data to Resulted
Sheets("Result").Cells(m, 1) = Desc(m)
Sheets("Result").Cells(m, 2) = Amount(m)
Next m
Exit Sub
AMOUNT_Error:
MsgBox Err.Description & " - " & Err.Number
End Sub