View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Wouter HM Wouter HM is offline
external usenet poster
 
Posts: 99
Default The Road- Matching data within a range of values

On 7 feb, 19:38, Rambo wrote:
Hi,

I have been given a rather difficult task and I was hoping someone
might be able to give me a start *I have two workbooks.

Workbook 1

Group * * Start * * * * * * *End * * * * * Rank
L * * * * *67105567 * * * 67115567 * * * * 1.807
L * * * * 201319966 * * 201329966 * * * * *0.631
M * * * * 33266853 * * *33276853 * * * * * 2.078

Workbook 2
Group * * Start * * * * * * *End
* *L * * * 27433757 * * 27507677
* *L * * *205694218 * * 205729852
* *M * * *27237837 * * *27289381

I am trying to figure out how to write code to compare each row in
Workbook 2 with the rows in Workbook 1. If the Group column matches
and the range of Workbook 2 fall within the range defined in Workbook
1 I would like to copy the value in the column rank to workbook 2.

Example (simplified)

Workbook 1

Group * * Start * * * * * * *End * * * * * Rank
* L * * * * * *2 * * * * * * * * *99 * * * * * * * 5
* L * * * * * *3 * * * * * * * * * *5 * * * * * * * 6

Workbook 2
Group * * Start * * * End
* L * * * * * * 3 * * * * * *4
* L * * * * * * 2 * * * * * *37

Workbook 2 (New)
Group * * Start * * * End * * Rank
* L * * * * * * 3 * * * * * *4 * * * * 6
* L * * * * * * 2 * * * * * *37 * * * 5

I know this is probably very complicated but again if anyone could
give me a shove in the right direction as to how to begin the coding I
would be very thankful

Rambo


Hi Rambo,

Try this:

Option Explicit

Sub RankOtherWorkbook()
Dim otherBook As Workbook

Dim thisSheet As Worksheet
Dim otherSheet As Worksheet


Dim thisCell As Range
Dim otherCell As Range

Set otherBook = Workbooks("Book2.xls")
Set thisSheet = ThisWorkbook.Sheets("Sheet1")
Set otherSheet = otherBook.Sheets("Sheet1")

Set otherCell = otherSheet.Cells(2, 1)
Do While Not IsEmpty(otherCell)
otherCell.Offset(0, 3).Value = "#NA"
Set thisCell = thisSheet.Cells(1, 1)
Do
Set thisCell = thisCell.Offset(1, 0)
If (thisCell.Value = otherCell.Value And _
thisCell.Offset(0, 1).Value <= otherCell.Offset(0,
1).Value And _
thisCell.Offset(0, 2).Value = otherCell.Offset(0,
2).Value) Then
otherCell.Offset(0, 3).Value = thisCell.Offset(0, 3)
End If
Loop Until IsEmpty(thisCell)
Set otherCell = otherCell.Offset(1, 0)
Loop
End Sub

Hoop This Helps,

Wouter