CODEWITHSUNDEEP
excelvba
GetSome _
GetSome _

Reputation: 59

return the value if its in within the range?

n this project i have to check column's A value between Column B and Column C. If columnA's values>= Columns B value or Columns A value<= Columns C value then i need to copy column d and e values and need to put into sheet1 column G and H. Column A is in sheet1 and Column B, C, D and E in sheet2.

   A       B    C   D     E
   1       1    9   Dog   Naruto
  11      10   19   Cat   one piece
  21      20   30   Duck  lo 
  1
  31
  12
  and so on

I want the outcome like this

   A    G       H
   1    Dog     Naruto   
   11   cat     One piece
   21   duck     o
   1    Dog     Naruto  
   31                   
   12   cat     One piece
   and so on

This is the code I got with the help of someone but its limited. I want it to return value no matter how many rows A column has.

Dim i As Long
Dim lRow As Long
Dim colA As Double, colB As Double, colC As Double

lRow = Sheets("Sheet1").Range("A" & 
         Sheets("Sheet1").Rows.Count).End(xlUp).Row
For i = 2 To lRow
    colA = Sheets("Sheet1").Range("A" & i).Value
    colB = Sheets("Sheet2").Range("B" & i).Value
    colC = Sheets("Sheet2").Range("C" & i).Value

    If colA >= colB Or colA <= colC Then
        Sheets("Sheet1").Range("G" & i).Value = Sheets("Sheet2").Range("D" & 
   i).Value
        Sheets("Sheet1").Range("H" & i).Value = Sheets("Sheet2").Range("E" & 
  i).Value
    End If
Next i

Upvotes: 0

Views: 307

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

If column B in Sheet2 is in a ascending order …

enter image description here

… you can easily do that with a formula. In B2 add the following formula and pull it down and right.

=INDEX(Sheet2!D:D,MATCH($A:$A,Sheet2!$B:$B,1))

And you will get this output in Sheet1:

enter image description here

The same approach would be possible with VBA using Application.WorksheetFunction but I recommend to use the formula.

VBA Solution

Option Explicit

Public Sub FindAndFillData()
    Dim wsDest As Worksheet
    Set wsDest = ThisWorkbook.Worksheets("Sheet1")

    Dim wsLookup As Worksheet
    Set wsLookup = ThisWorkbook.Worksheets("Sheet2")

    Dim LastRow As Long
    LastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row

    Dim MatchedRow As Double

    Dim iRow As Long
    For iRow = 2 To LastRow
        MatchedRow = 0 'initialize!
        On Error Resume Next
        MatchedRow = Application.WorksheetFunction.Match(wsDest.Cells(iRow, "A").Value, wsLookup.Columns("B"), 1)
        On Error GoTo 0

        If MatchedRow <> 0 Then
            If wsDest.Cells(iRow, "A").Value <= wsLookup.Cells(MatchedRow, "C").Value Then
                wsDest.Cells(iRow, "B").Value = wsLookup.Cells(MatchedRow, "D").Value
                wsDest.Cells(iRow, "C").Value = wsLookup.Cells(MatchedRow, "E").Value
            End If
        End If
    Next iRow
End Sub

Upvotes: 1

Related Questions