fixing my code doesn't work well

0

hello  

actually    I  got  this  code  from  the  internet  to  do  what  i  need  and  I    modified    to  do  that  with  my  data  but  i  failed  and  shows  me  the  data   are  not  correctly   ,  in sheet 1,2  this  is   the  same  range  from  a1: e     the   code  should  show all  of  data    in  sheet   summary  in  range   a2:  e   based on two  sheets  and  subtracting  the  values in  column   e  between two  sheets    i  put  the  result  in  sheet  summary   to understand  what   i  want 

Sub VenA()
  Set d = CreateObject("Scripting.Dictionary")
    For j = 1 To 2
      ar = Sheets(j).Cells(1).CurrentRegion
      For jj = 2 To UBound(ar)
        If d.exists(ar(jj, 1)) Then d(ar(jj, 1)) = Abs(d(ar(jj, 1) + ar(jj, 2) + ar(jj, 3) + ar(jj, 4) - ar(jj, 5))) Else d(ar(jj, 1) + ar(jj, 2) + ar(jj, 3) + ar(jj, 4)) = ar(jj, 5) * IIf(j = 1, -1, 1)

      Next jj
    Next j
    With Sheets("summary")
      .Cells(1).CurrentRegion.Offset(1).Clear
      .Cells(2, 1).Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
      .Cells(1).CurrentRegion.Sort .Cells(1), , , , , , , 1
    End With
End Sub

so   i  hope  somebody   helps  from  the  experts 

thanks  in advance   

Answer
Discuss

Answers

1
Selected Answer

Your code is very smartly made but very badly written. Moreover, your instruction was also poor. Therefore the outcome is - - - more delay whiole you ask another question.

Start with your instruction. You never said if your CODE is unique or not. It must be unique. The guy who wrote the code knew that. I know that, too. But someone else thought he would create a unique identifier by merging columns 1 to 4. But that is a bad way and he didn't know how to do it, either. Therefore the outcome is  - - -  the new code again presumes that the CODE is unique in both source sheets.

Apart from the above I stuck with the original design but I added Option Explicit at the top of the code and I gave all variables meaningful names. That's elementary coding. You shouldn't waste your time on code that doesn't observe these rules. I then added a lot of comments, especial about the variables that you can change yourself. In this way you have two advantages.

  1. If you study the code you can learn to improve or modify it.
  2. If you give it to someone else to modify he will find it easy to do.
Option Explicit

Sub CreateSummary()
    ' 179

    Const CodeClm       As Long = 1         ' change to suit
    Const QtyClm        As Long = 5         ' change to suit

    Dim Ws(1)           As Worksheet        ' 0=In (plus), 1=Out (minus)
    Dim Inventory       As Object           ' Scripting.Dictionary
    Dim Data            As Variant          ' data from Ws()
    Dim Arr             As Variant          ' row from Data
    Dim i               As Integer          ' loop counter: index of Ws
    Dim R               As Long             ' loop counter: Data rows
    Dim C               As Long             ' loop counter: Data columns

    Set Ws(0) = Worksheets("RR1")           ' In: change name to suit
    Set Ws(1) = Worksheets("RR2")           ' Out: change name to suit
    Set Inventory = CreateObject("Scripting.Dictionary")

    For i = 0 To 1
        Data = Ws(i).Cells(1).CurrentRegion
        For R = 1 To UBound(Data)
            If Inventory.Exists(Data(R, CodeClm)) Then
                If R > 1 Then
                    Arr = Inventory(Data(R, CodeClm))
                    Arr(QtyClm) = Arr(QtyClm) + (Data(R, QtyClm) * IIf(i, -1, 1))
                    Inventory(Data(R, CodeClm)) = Arr
                End If
            Else
                ReDim Arr(CodeClm To QtyClm)
                For C = LBound(Arr) To UBound(Arr)
                    Arr(C) = Data(R, C)
                Next C
                If (i = 1) And (R > 1) Then Arr(QtyClm) = Arr(QtyClm) * -1
                Inventory.Add Data(R, CodeClm), Arr
            End If
        Next R
    Next i

    R = 0                                       ' target row
    With Worksheets("Summary")                 ' change to suit
        .Cells.ClearContents                    ' clear al
        For Each Data In Inventory.Keys
            R = R + 1
            Arr = Inventory(Data)
            .Cells(R, 1).Resize(1, UBound(Arr)).Value = Arr
        Next Data
    End With
End Sub

Your original code sorted the data. I omitted that step. However, if you need it it's easy to sort the dictionary before writing the result to the Summary sheet.

Discuss

Discussion

@Variatus  you're  really  professional     your  code  does  what   i  want   without  any  problem     many  thanks  for  the  code  and   the  comments  which   are  inside  the  code   it  will  help  me  more    and  the notices   and  my  apology  if  my  data  is confusing  best  regards
leap (rep: 6) Feb 22, '21 at 12:21 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login