Correlating rows on different sheets

  • Thread starter Thread starter GSBrown123
  • Start date Start date
G

GSBrown123

Hi,

First of all apologies for the title of my post. I really don't know
what the name of the function is that I'm trying to achieve.

I'm trying get a macro to correlate data that appear on 2 separate
sheets and transfer the relevant data over.
For example...

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 number is also found in sheet 2 in column C. The P
number in sheet 2 column C 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 C.
For each P number in sheet 1 column A it needs to remove data from
sheet 2 colums G to T and copy it into the end columns of sheet 1 on
the rows of the relvant 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. If this is the case the new columns in sheet 1
should read "No Data".

Thanks
G
 
Your posting for sheet 2 has both colun c and Column F as the search column.
which one is correct?


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
.Range("G" & Sh2RowCount & ":T" & Sh2RowCount).Copy
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
 
I had one extra line in my porevious code that does no harm, but should be
removed

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
 
I had one extra line in my porevious code that does no harm, but should be
removed

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









- Show quoted text -
Click to expand...


Thank Joel

The correct column is F.

I've tried the code but can't get it to work.

Please can you define any integers/variables/strings etc that you have
used at the beginning of the code please.

George
 
I assume you are not getting any errors?

Usually code like this doesn't work because of blank cells. The code stops
running when it finds the first blank cells in Sheet1 in column A and column
c in Sheet2.

The two lines below have to be set for the first row where data is found.
If row one doesn't contain data then that is why the code doesn't work.

Sh1RowCount = 1
Sh2RowCount = 1
 
Back
Top