Excel VBA making different sets based on unique records and salary

I have below data

 Empid       Empname   salary   Company   location   status
    xx         Jhon      100      IBM        us   
    x1         Phil       50      IBM        us
    x2         Karl       30      IBM        us
    x3         Stev开发者_JAVA百科e      20      IBM        us
    x4         jacob      70      Oracle     uk
    x5         jason      30      Oracle     uk
    x6         stuart     50      Oracle     uk
    zz         jay        150      Oracle    uk
   x10         Steve1     20      IBM        ind
    x9         Steve2     20      IBM        nj

I have to separate records based on company and location. So I will get below two sets of records.

First Set

Empid     Empname   salary   company    Location  status
    xx        Jhon             100      IBM           us   
    x1        Phil             50       IBM          us
    x2        Karl             30       IBM         us
    x3        Steve            20       IBM         us

Second set

   Empid     Empname   salary   company  Location  status
    x4        jacob      70       Oracle    uk
    x5        jason      30       Oracle    uk
    x6        stuart     50       Oracle    uk
    zz        jay       150       Oracle    uk

In above sets XX,zz are master records. I check if x1+x2+x3 =xx salary. If it is equal then I write as matched in the column status for that set otherwise I ignore. Last two rows in original sheets should ignore because it does not have a master record.

Sub Tester()       

    Const COL_COMP As Integer = 4
    Const COL_LOC As Integer = 5
    Const VAL_DIFF As String = "XXdifferentXX"

    Dim d As Object, sKey As String
    Dim rw As Range, opt As String, rngData As Range
    Dim rngCopy As Range
    Dim FirstPass As Boolean

        With Sheet1.Range("A1")
            Set rngData = .CurrentRegion.Offset(1).Resize( _
                             .CurrentRegion.Rows.Count - 1)
        End With
        Set rngCopy = Sheet2.Range("A2")

        Set d = CreateObject("scripting.dictionary")
        FirstPass = True

redo:
        For Each rw In rngData.Rows
            sKey = rw.Cells(COL_COMP).Value & "<>" & _
                   rw.Cells(COL_LOC).Value
  'Here i have to make different sets of data.

                       Next rw
        If FirstPass Then
            FirstPass = False
            GoTo redo
        End If

    End Sub

---

use below solution if anyone facing for similar kind of problem

Regards, Raj

Sub tester()

    Const COL_EID As Integer = 1
    Const COL_comp As Integer = 4
    Const COL_loc As Integer = 5
    Const COL_sal As Integer = 3
    Const COL_S As Integer = 6
    Const VAL_DIFF As String = "XXdifferentXX"

    Dim d As Object, sKey As String, sKey1 As String, id As String
    Dim rw As Range, opt As String, rngData As Range
    Dim rngCopy As Range, goodId As Boolean, goodId1 As Boolean
    Dim FirstPass As Boolean, arr, arr1

    Dim sal As Integer
    Dim colsal As Integer
    Dim mastersal As Integer
    Dim status As Boolean
    Dim status1 As Boolean

        With Sheet1.Range("A1")
            Set rngData = .CurrentRegion.Offset(1).Resize( _
                             .CurrentRegion.Rows.Count - 1)
        End With
        Set rngCopy = Sheet2.Range("A1")
         FirstPass = True
        SecondPass = False
      status = False
       Set a = CreateObject("scripting.dictionary")

        Set d = CreateObject("scripting.dictionary")


    redo:

        For Each rw In rngData.Rows

            sKey = rw.Cells(COL_comp).Value & "<>" & _
                   rw.Cells(COL_loc).Value
            sKey1 = rw.Cells(COL_comp).Value & "<>" & _
                   rw.Cells(COL_loc).Value
            colsal = rw.Cells(COL_sal).Value
            If FirstPass Then
              id = rw.Cells(COL_EID).Value
              goodId = (id = "xx" Or id = "zz")

              If d.exists(sKey) Then
                  arr = d(sKey) 'can't modify the array in situ...

                  If goodId Then arr(0) = True
                  d(sKey) = arr 'return [modified] array

              Else
                  d.Add sKey, Array(goodId)
            End If
            End If

            If SecondPass Then
              id = rw.Cells(COL_EID).Value
              goodId1 = (id = "xx" Or id = "zz")

             If d(sKey)(0) = True Then
             If goodId1 Then mastersal = rw.Cells(COL_sal).Value
             If a.exists(sKey1) Then
                  arr1 = a(sKey1) 'can't modify the array in situ...

                  If goodId1 = False Then sal = sal + colsal
                   If mastersal = sal Then arr1(0) = True



                  'If goodId1 Then arr1(0) = True
                  a(sKey1) = arr1 'return [modified] array

              Else
                  a.Add sKey1, Array(status)
                  sal = 0
                   If goodId1 = False Then sal = sal + colsal
            End If

            End If
            End If

             If FirstPass = False And SecondPass = False Then
            If d(sKey)(0) = True Then
              If a(sKey1)(0) = True Then
                  rw.Copy rngCopy
                  Set rngCopy = rngCopy.Offset(1, 0)
             End If
            End If
            End If


        Next rw
        If SecondPass Then
            SecondPass = False
            GoTo redo
        End If
        If FirstPass Then
            FirstPass = False
            SecondPass = True
            colsal = 0
            GoTo redo
        End If

    End Sub