Extract corresponding cells (same Row and Column) from two sheets

Question

With Excel 2003, I have to extract data from two sheets of the same layout. For example:

Sheet 1 (Digits)

      H1  H2  H3  H4  H5
DAY1  20  10  22  10  23
DAY2  14  25  21  17  8
DAY3  26  12  13  18  9
DAY4  2   45  8   7   9
DAY5  6   8   7   8   30

Sheet 2 (Corresponding characters)

      H1  H2  H3  H4  H5
DAY1  AB  DF  DS  RE  GF
DAY2  DF  SD  QE  TY  EW
DAY3  ER  WE  QW  YT  IY
DAY4  WE  NB  RE  SD  HK
DAY5  IU  PO  ER  ER  MB

I want to extract all the values greater than or equal to 20 from Sheet 1 and their corresponding characters from Sheet 2, to result in:

DAY1 H1 20 AB
DAY1 H3 22 DS
DAY1 H5 23 GF
DAY2 H2 25 SD
DAY2 H3 21 QE
DAY3 H1 26 ER
DAY4 H2 45 NB
DAY5 H5 30 MB

Is there a quick way to achieve this?

peege · Accepted Answer · 2014-12-24T09:17:45.927

That isn't hard at all. Since you have a nice layout especially and the values actually match up from sheet to sheet, it makes it very easy.

Here is the flow:

Loop through the rows on Sheet1
Get the Temp Day.
Loop through the columns on that row.
Assign the value of each cell to a temp Value and test it.
If the criteria is met, assign the values on the third sheet as needed.

TESTED:

Sub ExtractConditionally()

Dim lastRow As Long
Dim lastCol As Long
Dim s1 As String        'Sheet 1 Name
Dim s2 As String        'Sheet 2 Name
Dim s3 As String        'Combined Sheet Name
Dim tempDay As String
Dim tempVal As Double
Dim tRow As Long        'Target Row on Combined Sheet
Dim tCol As Long        'Target Column on Combined Sheet

    s1 = "Sheet1"
    s2 = "Sheet2"
    s3 = "Combined"
    tRow = 1    'No header row for combined sheet, as shown in description

    lastRow = Sheets(s1).Range("A" & Rows.count).End(xlUp).row
    lastCol = Sheets(s1).Cells(2, Columns.count).End(xlToLeft).column

    For lRow = 2 To lastRow     'Loop through Rows on Sheet1

        tempDay = Sheets(s1).Cells(lRow, 1)         'Assign the temp Day

        For lCol = 2 To lastCol                     'Loop BY column
            tempVal = Sheets(s1).Cells(lRow, lCol)  'Get the temp value

            If tempVal >= 20 Then                   'Test the value
            'Matched criteria, now set the target sheet
                Sheets(s3).Cells(tRow, 1) = tempDay
                Sheets(s3).Cells(tRow, 2) = Sheets(s1).Cells(1, lCol)
                Sheets(s3).Cells(tRow, 3) = tempVal
                Sheets(s3).Cells(tRow, 4) = Sheets(s2).Cells(lRow, lCol)
                tRow = tRow + 1     'Increment target Row
            End If
        Next lCol
    Next lRow

End Sub

Sheet1 Sheet2 Sheet3

score 1 · Answer 2 · edited May 23 '17 at 12:12

1

Without VBA:

Follow the steps detailed here selecting Sheet1 data for your first range.

Apply Table, Convert to range. Copy the Value column into ColumnD. Delete D1 with shift cells up. Filter to select is greater than 0 in ColumnD and delete all but Row1. Filter to select is less than 20 in ColumnC and delete all but Row1. Delete last populated row.

edited May 23 '17 at 12:12

Community

1
1

answered Dec 24 '14 at 01:23

pnuts

58,317
11
87
139

Extract corresponding cells (same Row and Column) from two sheets

2 Answers2