Code:
Sub Consolidator()

    Dim rngPosition As Range, rngAccounts As Range, rngHistory As Range
    Dim rngA As Range, rngP As Range, rngH As Range
    Dim strPeriodCriteria As String
    Dim objDic As Object: Set objDic = CreateObject("Scripting.Dictionary") ' New Dictionary
    With Worksheets("Sheet1")
        Set rngPosition = .Range("SamplePositions")
        Set rngAccounts = .Range("SampleAccounts")
        Set rngHistory = .Range("SampleHistory")
        strPeriodCriteria = .Range("O17").Value & .Range("O18").Value
        For Each rngA In rngAccounts.Columns(1).Cells
            For Each rngP In rngPosition.Columns(1).Cells
                If rngP.Value = rngA.Value Then
                    If rngP.Offset(, 2).Value & rngP.Offset(, 3).Value = strPeriodCriteria Then
                        objDic.Item(rngP.Value & "|" & rngP.Offset(, 1).Value) = 0
                    End If
                End If
            Next rngP
            For Each rngH In rngHistory.Columns(1).Cells
                If rngH.Value = rngA.Value Then
                    If Replace(Mid(rngH.Offset(, 4), 2), " ", "") = strPeriodCriteria Then
                        objDic.Item(rngH.Value & "|" & rngH.Offset(, 1).Value) = 0
                    ElseIf rngH.Offset(, 2).Value & rngH.Offset(, 3).Value & Replace(Mid(rngH.Offset(, 4), 2), " ", "") = strPeriodCriteria Then
                        objDic.Item(rngH.Value & "|" & rngH.Offset(, 1).Value) = 0
                    End If
                End If
            Next rngH
        Next rngA
        .Range("Original").Offset(1).ClearContents
        .ListObjects("Original").Resize .Range("$A$1:$D$2")
        .Range("Original").Range("A1").Resize(objDic.Count).Value = Application.Transpose(objDic.Keys)
        Application.DisplayAlerts = 0
        .Range("Original").Columns(1).Cells.TextToColumns _
                                Destination:=.Range("A2"), _
                                DataType:=xlDelimited, _
                                TextQualifier:=xlDoubleQuote, _
                                ConsecutiveDelimiter:=False, _
                                Tab:=True, _
                                Semicolon:=False, _
                                Comma:=False, Space:=False, _
                                Other:=True, OtherChar:="|", _
                                FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
                                TrailingMinusNumbers:=True
        Application.DisplayAlerts = 1
    End With
    
End Sub