To all,

I have a question as follows:

I’m trying get a macro to correlate data that appears on 2 separate
sheets and transfer the relevant data over.


Sheet 1 has dozens of lines of data spread over several columns which
is updated daily.

Column A in sheet 1 contains a number. For easy I’ll call it a P
number.

The same P number is also found in sheet 2 in column F .

The P number in sheet 2 column F can sometimes have a letter before it
and sometimes after but it is number that is the reference and is the
same P number in sheet 1 column A.

I need a macro to run daily when requested to take the P number in
sheet 1 column A for each line and find the same P number (discounting
any letters present in the cell) in sheet 2 column F.

For each P number in sheet 1 column A it needs to remove data from
sheet 2 column G to T and copy it into the end columns of sheet 1 on
the rows of the relevant P number from sheet 2.

For every P number in sheet 1 column A there may not be a P number in
sheet 2 column F.

I had a response back from a user which is as follows, but I cant get
this to work:

Sh1RowCount = 1
With Sheets("Sheet1")
Do While .Range("A" & Sh1RowCount) < ""
find_Num = .Range("A" & Sh1RowCount)
With Sheets("Sheet2")
Found = False
Sh2RowCount = 1
Do While .Range("C" & Sh2RowCount) < ""
OldNum = .Range("C" & Sh2RowCount)
'remove characters from number
NewNum = ""
Do While OldNum < ""
If IsNumeric(Left(OldNum, 1)) Then
NewNum = NewNum & Left(OldNum, 1)
End If
If Len(OldNum) 1 Then
OldNum = Mid(OldNum, 2)
Else
OldNum = ""
End If
Loop
NewNum = Val(NewNum)
If find_Num = NewNum Then
Found = True
Exit Do
End If
Sh2RowCount = Sh2RowCount + 1
Loop
End With


LastCol = .Cells(Sh1RowCount,
Columns.Count).End(xlToLeft).Column
NewCol = LastCol + 1
If Found = False Then
.Cells(Sh1RowCount, NewCol) = "No Data"
Else
Sheets("Sheet2").Range("G" & Sh2RowCount & ":T" &
Sh2RowCount).Copy _
Destination:=.Cells(Sh1RowCount, NewCol)
End If
Sh1RowCount = Sh1RowCount + 1
Loop
End With

Does anyone have any ideas on how I can make this work? Or am I
missing something very simple?

Thanks in advance for your help,

Regards

Joseph Crabtree

I think this is my code. Don't remeber because I answer a lot of questions.
When people have problems with this type code it is usually becuase there
are blank cell in the data. The code expects Data to start in column A Row 1
on both worksheets and contains no blank cells in column A, Otherwise the
code stops. You don't say you have any errors.

You can change the following 2 lines as need to start from a row other than 1

Sh1RowCount = 1
Sh2RowCount = 1



"joecrabtree" wrote:



To all,

I have a question as follows:

Im trying get a macro to correlate data that appears on 2 separate
sheets and transfer the relevant data over.


Sheet 1 has dozens of lines of data spread over several columns which
is updated daily.

Column A in sheet 1 contains a number. For easy Ill call it a P
number.

The same P number is also found in sheet 2 in column F .

The P number in sheet 2 column F can sometimes have a letter before it
and sometimes after but it is number that is the reference and is the
same P number in sheet 1 column A.

I need a macro to run daily when requested to take the P number in
sheet 1 column A for each line and find the same P number (discounting
any letters present in the cell) in sheet 2 column F.

For each P number in sheet 1 column A it needs to remove data from
sheet 2 column G to T and copy it into the end columns of sheet 1 on
the rows of the relevant P number from sheet 2.

For every P number in sheet 1 column A there may not be a P number in
sheet 2 column F.

I had a response back from a user which is as follows, but I cant get
this to work:

Sh1RowCount = 1
With Sheets("Sheet1")
Do While .Range("A" & Sh1RowCount) < ""
find_Num = .Range("A" & Sh1RowCount)
With Sheets("Sheet2")
Found = False
Sh2RowCount = 1
Do While .Range("C" & Sh2RowCount) < ""
OldNum = .Range("C" & Sh2RowCount)
'remove characters from number
NewNum = ""
Do While OldNum < ""
If IsNumeric(Left(OldNum, 1)) Then
NewNum = NewNum & Left(OldNum, 1)
End If
If Len(OldNum) 1 Then
OldNum = Mid(OldNum, 2)
Else
OldNum = ""
End If
Loop
NewNum = Val(NewNum)
If find_Num = NewNum Then
Found = True
Exit Do
End If
Sh2RowCount = Sh2RowCount + 1
Loop
End With


LastCol = .Cells(Sh1RowCount,
Columns.Count).End(xlToLeft).Column
NewCol = LastCol + 1
If Found = False Then
.Cells(Sh1RowCount, NewCol) = "No Data"
Else
Sheets("Sheet2").Range("G" & Sh2RowCount & ":T" &
Sh2RowCount).Copy _
Destination:=.Cells(Sh1RowCount, NewCol)
End If
Sh1RowCount = Sh1RowCount + 1
Loop
End With

Does anyone have any ideas on how I can make this work? Or am I
missing something very simple?

Thanks in advance for your help,

Regards

Joseph Crabtree