Return cell values for non-matching & matching criteria

Issue.xls

Sorry here is the file.

The data comes in different sizes which means the following:
The nummer of columns in Row 1 Will differ, meaning that sometimes there can be more points like "AN" and "AT" hence they need to be included in sheet3. These new entries Will also have corresponding values that needs to be inserted as well... But the number of rows in each sheet is always fixed...

Very Nice made. It seems to work perfect. How can I get/see the code?

Download the file again.

See the codes in

Module1 "test" sub procedure code.
Ark3 Sheet module "Sheet_Activate" event code calling "test".
ThisWorkbook module, Workbook_Open event code calling "test".

So it will always update whenever you activate "Ark3" sheet.

Ok now I can see it. Thank you very much, I appreciate it a lot. I'm new to this forum so I'm not exactly sure how it works.

First question:

What if the data has less than 10 rows?


Second question:

I don't think "For Next Loop" fits well for this particular problem.
I would rather use Range.Find or Worksheet.Function.Match method to see if the matching heading exists or not.

1) Clear Sheet3.
2) Copy Sheet1 data to Sheet3.
3) Loop through Row1(Heading) to find matching heading in Sheet2 Row1.
4) If matching heading found, copy from whichever row(s) of data you want to under the matching column.
5) If not, add new column in Sheet3.

This is what I would do.

The data will always be a fixed number of rows which is 45, so that particular problem will not happen.
Ok, that's also what I was guessing, but I wasn't sure though. I see what you mean with your and I'll try to work on it.

The data will always be a fixed number of rows which is 45, so that particular problem will not happen.
Ok, that's also what I was guessing, but I wasn't sure though. I see what you mean with your description and I'll try to work on it.

Originally Posted by jenz_skallemose

The data will always be a fixed number of rows which is 45, so that particular problem will not happen.

Sub test()
    Dim dic As Object, ws As Worksheet, r As Range, i As Long, ii As Long
    Dim w() As Double, maxRow As Long, n As Long, e, mySheets
    Const RowLimit = 45, startRow As Long = 4, endRow As Long = 10
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    mySheets = VBA.Array("Ark1", "Ark2")
    For i = 0 To UBound(mySheets)
        With Sheets(mySheets(i)).Cells(1).CurrentRegion.Resize(RowLimit)
            For Each r In .Rows(1).Cells
                If Not dic.exists(r.Value) Then
                    ReDim w(1 To endRow - startRow + 1 + n)
                Else
                    w = dic(r.Value)
                    ReDim Preserve w(1 To endRow - startRow + 1 + n)
                End If
                For ii = startRow To endRow
                    w(n + ii - startRow + 1) = r(ii).Value
                Next
                dic(r.Value) = w
                maxRow = Application.Max(maxRow, UBound(w))
            Next
            n = n + endRow - startRow + 1
        End With
    Next
    For Each e In dic
        w = dic(e)
        If UBound(w) < maxRow Then ReDim Preserve w(1 To maxRow)
        dic(e) = w
    Next
    With Sheets("Ark3")
        .UsedRange.Clear
        .Cells(1).Resize(, dic.Count).Value = dic.keys
        .Cells(2, 1).Resize(maxRow, dic.Count).Value = _
        Application.Transpose(dic.items)
    End With
End Sub

Ah that was a clarifying moment. Now I think I understand the whole part of the code as well Thank you so much for your help - it's very appreciated.