Extracting Data

[PG626]

Hello,
I would like to extract all the "No's" into another sheet and will have a filter of the award fields and yield which AWD-xxxx had a No.

 

[Logit]

Try this and let me know if it works. Untested here.

Sub ExtractNos()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long
    Dim j As Long
    Dim lastRow As Long
    Dim outputRow As Long
    Dim col As Long
    Dim colHeaders As Variant

    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")

    colHeaders = Array("C", "D", "E", "F", "G", "H", "I") ' Columns to check

    ws2.Cells.Clear ' Clear Sheet2 before copying

    ' Set header for Sheet2
    ws2.Range("A1").Value = "Row"
    ws2.Range("B1").Value = "Column"
    ws2.Range("C1").Value = "Value"
    ws2.Range("D1").Value = "Award Field"

    outputRow = 2

    ' Loop through each row in Sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        ' Loop through each specified column
        For j = LBound(colHeaders) To UBound(colHeaders)
            col = ws1.Columns(colHeaders(j)).Column
            If ws1.Cells(i, col).Value = "No" Then
                ws2.Cells(outputRow, 1).Value = i
                ws2.Cells(outputRow, 2).Value = colHeaders(j)
                ws2.Cells(outputRow, 3).Value = ws1.Cells(i, col).Value
                ws2.Cells(outputRow, 4).Value = "AWD-" & Format(outputRow - 1, "0000")
                outputRow = outputRow + 1
            End If
        Next j
    Next i

    MsgBox "Extraction complete!"
End Sub

 

[Fuji]

PG626,​

Here's how I interpret your question.
Assuming data in Sheet1 and the result in Sheet2.

Sub test()
    Dim a, i&, ii&, n&
    a = Sheets("sheet1").[a1].CurrentRegion.Value2
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 2)
    b(1, 1) = "Award Fields": b(1, 2) = "AWD No": n = 1
    For ii = 3 To UBound(a, 2)
        For i = 2 To UBound(a, 1)
            If a(i, 1) = "" Then a(i, 1) = a(i - 1, 1)
            If a(i, ii) = "No" Then
                n = n + 1
                b(n, 1) = a(i, 1) & IIf(a(i, 2) <> "", " / " & a(i, 2), "")
                b(n, 2) = a(1, ii)
            End If
        Next
    Next
    With Sheets("sheet2").Columns("a:b")
        .ClearContents
        .Resize(n) = b
        .Columns.AutoFit
    End With
End Sub