I have range of years from 1994-2014 and for a reach corresponding company names values lies against each other (Output Sheet). There are sales figure for the respective company for each year which I used this formula (below) to get from the Sheet1 to output sheet.

Source Sheet/Sheet1

Output Sheet

=INDEX('Sheet1'!$E$5:$Y$685,MATCH(Output!B2,'Sheet1'!$D$5:$D$685,0),MATCH(Output!A2,'Sheet1'!$E$4:$Y$4,0))

I used two match formula as I wanted to validate company name as well as the year.

NOW, I want to check the values I retrieved from the above equation is an exact match/True to the source value. Thus, I tried using this formula but although the first IF logical is true, the second fails.

=IFS(Output!B2=INDEX('Sheet1'!$D$5:$D$685,MATCH(Output!B2,'Sheet1'!$D$5:$D$685,0)),"OK",C2=INDEX('Sheet1'!$E$5:$Y$685,MATCH(Output!B2,'Sheet1'!$D$5:$D$685,0),MATCH(Output!A2,'Sheet1'!$E$4:$Y$4,0)),"FINE")

I am looking for VBA code for the entire task at hand in case VBA makes it easier as I have huge dataset to perform the same procedure.

CodePudding user response：

A VBA Unpivot

• Copy the code into a standard module, e.g. Module1 of the workbook containing the two worksheets.
• Carefully adjust the values in the constants section.
• Both cell addresses refer to the first cells of the table headers.
• You should give PowerQuery a try. It will take a few minutes once you get a hang of it. And it has a ton of options.

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Unpivots a table range (has headers) to another worksheet.
' Calls:        'RefCurrentRegionBottomRight'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub UnPivotData()
    
    ' Source
    Const sName As String = "Sheet1"
    Const sFirstCellAddress As String = "D4"
    Const scCount As Long = 22
    ' Destination
    Const dName As String = "Output"
    Const dFirstCellAddress As String = "A1"
    Dim dHeaders As Variant: dHeaders = VBA.Array("YEAR", "COMPANY", "WC01651")
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Write from source range to source array.
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim sfCell As Range: Set sfCell = sws.Range(sFirstCellAddress)
    Dim srg As Range
    Set srg = RefCurrentRegionBottomRight(sfCell).Resize(, scCount)
    Dim srCount As Long: srCount = srg.Rows.Count
    Dim sData As Variant: sData = srg.Value
    
    ' Size destination array.
    Dim dhUpper As Long: dhUpper = UBound(dHeaders)
    Dim drCount As Long: drCount = (srCount - 1) * (scCount - 1)   1
    Dim dcCount As Long: dcCount = dhUpper   1 ' zero- vs one-based
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To dcCount)
    
    ' Write headers.
    Dim dh As Long
    For dh = 0 To dhUpper
        dData(1, dh   1) = dHeaders(dh)
    Next dh
    
    Dim dr As Long: dr = 1 ' headers already written
    Dim sr As Long
    Dim sc As Long
    
    ' Write data ('body').
    For sr = 2 To srCount
        For sc = 2 To scCount
            dr = dr   1 ' Note the 'PowerQuery' terms in parentheses: 
            dData(dr, 1) = sData(1, sc) ' write column labels (attributes)
            dData(dr, 2) = sData(sr, 1) ' write row labels
            dData(dr, 3) = sData(sr, sc) ' write values (values)
        Next sc
    Next sr
    
    ' Write from destination array to destination range.
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
    Dim dcrg As Range
    Set dcrg = dfCell.Resize(dws.Rows.Count - dfCell.Row   1, dcCount)
    dcrg.ClearContents
    Dim drg As Range: Set drg = dfCell.Resize(drCount, dcCount)
    drg.Value = dData
    
    MsgBox "Data transferred.", vbInformation
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns a reference to the range starting with a given cell
'               and ending with the last cell of its Current Region.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCurrentRegionBottomRight( _
    ByVal FirstCellRange As Range) _
As Range
    If FirstCellRange Is Nothing Then Exit Function
    With FirstCellRange.Cells(1).CurrentRegion
        Set RefCurrentRegionBottomRight = _
            FirstCellRange.Resize(.Row   .Rows.Count - FirstCellRange.Row, _
            .Column   .Columns.Count - FirstCellRange.Column)
    End With
End Function