Snasui Excel Forum

Code: Select all

Set rColA = Sheets("Input data").Range("A2:A1000")
For Each iTemNo In Range("O16:O1000.)

Code: Select all

Sub InspectionData()
    Dim iTemNo As Range, rColA As Range, rnLastRow As Long, rnLastRow2 As Long, lCount As Long, _
        rHeadNoData As Range, rHeadNoInput As Range, rFind As Range, rnHead As Range
    Worksheets("format").Activate
    Set rHeadNoData = ActiveSheet.Range("B1:O1")
    Set rHeadNoInput = Sheets("Format").Range("X1:AB1")
    rnLastRow = Sheets("Format").Range("W" & Rows.Count).End(xlUp).Row
    rnLastRow2 = Sheets("Format").Range("Q" & Rows.Count).End(xlUp).Row
    Set rColA = Sheets("Format").Range("W2:W" & rnLastRow)
    For Each iTemNo In Range("P3:P" & rnLastRow2)
        lCount = Application.CountIf(rColA, iTemNo)
        If lCount > 0 Then
            lCount = Application.Match(iTemNo, rColA, 0) + 1
            For Each rnHead In rHeadNoData
                Set rFind = rHeadNoInput.Find(what:=rnHead.Value)
                If Not rFind Is Nothing Then
                    rnHead.Offset(iTemNo.Row - rnHead.Row, 0).Value = _
                    rFind.Offset(lCount - 1, 0).Value
                Else
                    rnHead.Offset(iTemNo.Row - rnHead.Row, 0).Value = ""
                End If
            Next rnHead
        End If
    Next iTemNo
    MsgBox ("InspectionData Finish")
End Sub

Code: Select all

lastrow = Sheets(2).Range("c2").Resize(1000, 8).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

Code: Select all

Set rColA = Sheets("Input data").Range("A2:A" & lastrow)

Code: Select all

iTemNo In Range("O16:O" & lastrow)

Code: Select all

Sub InspectionData()
    Dim iTemNo As Range, rColA As Range, lastrow As Long, lastrow2 As Long, lCount As Long, _
        rHeadNoData As Range, rHeadNoInput As Range, rFind As Range, rnHead As Range
    Worksheets("format").Activate
    Set rHeadNoData = ActiveSheet.Range("a13:c13")
    Set rHeadNoInput = Sheets("Input data").Range("c1:e1")
    lastrow = Sheets("Input data").Range("B:B").End(xlUp).Row
    lastrow2 = Sheets("Input data").Range("R:R").End(xlUp).Row
    Set rColA = Sheets("Input data").Range("A2:A" & lastrow)
    For Each iTemNo In Range("O16:O" & lastrow)
        lCount = Application.CountIf(rColA, iTemNo)
        If lCount > 0 Then
            lCount = Application.Match(iTemNo, rColA, 0) + 1
            For Each rnHead In rHeadNoData
                Set rFind = rHeadNoInput.Find(what:=rnHead.Value)
                If Not rFind Is Nothing Then
                    rnHead.Offset(iTemNo.Row - rnHead.Row, 0).Value = _
                    rFind.Offset(lCount - 1, 0).Value
                Else
                    rnHead.Offset(iTemNo.Row - rnHead.Row, 0).Value = ""
                End If
            Next rnHead
        End If
    Next iTemNo
    MsgBox ("InspectionData Finish")
End Sub