To retrieve the particular cell value Solved/Closed

Question

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

kaiyasit · Answer

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

kaiyasit · Answer

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

saran · Answer

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

kaiyasit · Answer

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

To retrieve the particular cell value

4 responses

Similar discussions

Subscribe To Our Newsletter!