To retrieve the particular cell value

Solved/Closed
saran - Aug 18, 2009 at 01:31 AM
kaiyasit Posts 30 Registration date Sunday August 9, 2009 Status Member Last seen April 20, 2010 - Aug 19, 2009 at 06:01 AM
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

kaiyasit Posts 30 Registration date Sunday August 9, 2009 Status Member Last seen April 20, 2010 12
Aug 18, 2009 at 02:43 AM
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
Hey Thanks!!! I works perfect with Ucase :)
0
kaiyasit Posts 30 Registration date Sunday August 9, 2009 Status Member Last seen April 20, 2010 12
Aug 18, 2009 at 02:39 AM
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
0
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
0
kaiyasit Posts 30 Registration date Sunday August 9, 2009 Status Member Last seen April 20, 2010 12
Aug 19, 2009 at 06:01 AM
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
0