Previous Topic Next Topic

How deal with this complicated code and updating(subtraction between two sheets)

Solved/Closed
Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022 - Updated on Aug 24, 2021 at 03:34 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Sep 27, 2021 at 11:23 AM
Hello,


I need help from experts to updating this complicated code . I know this way is very complicated to subtracting the items . the code works well and subtracting the sheet KEYS OUT for each items in COL (A) bsed on col B,C,D from sheet SH for each ITEM in COL B based on COL C,D,E and the result should show in sheet RS . the problem is when repeat the data in sheet SH it just subtracts from the last value with ignore the others . it should subtracting from all data repeated in sheet SH . I put the right result in sheet right and some comments and highlight some cells to understand it 
Sub Subtract_Likes()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim s As String, CurrItm As String, OrdClnt As String
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Sheets("SH").Range("A1").CurrentRegion.Value
  For i = 2 To UBound(a)
    If Len(a(i, 2)) > 0 Then
      CurrItm = a(i, 2)
      OrdClnt = a(i, 3) & ";" & a(i, 4)
    End If
    d(Join(Array(CurrItm, a(i, 5), a(i, 6), a(i, 7)), ";")) = OrdClnt & " " & a(i, 8)
  Next i
  a = Sheets("Keys out").Range("A1").CurrentRegion.Value
  ReDim b(1 To UBound(a), 1 To 1)
  b(1, 1) = "ITEMS;ORDER  NO;CLIENT NO;BRAND;TYPE;ORIGIN;BALANCE"
  For i = 2 To UBound(a)
    If Len(a(i, 1)) > 0 Then CurrItm = a(i, 1)
    s = CurrItm & ";" & a(i, 2) & ";" & a(i, 3) & ";" & a(i, 4)
    If d.exists(s) Then
      s = Replace(s, ";", ";" & IIf(Len(a(i, 1)) > 0, Split(d(s))(0), ";") & ";", 1, 1) & ";" & a(i, 5) - Split(d(s))(1)
    Else
      s = Replace(s, ";", ";-;-;", 1, 1) & ";" & a(i, 5)
    End If
    If Len(a(i, 1)) = 0 Then s = Replace(s, CurrItm, "", 1, 1)
    b(i, 1) = s
  Next i
  With Sheets("RS")
    Intersect(.UsedRange, .Columns("A:G")).ClearContents
    With .Range("A1").Resize(UBound(b))
      .Value = b
      .TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
      .Resize(, 7).Columns.AutoFit
    End With
  End With
End Sub


here is my file
https://www.dropbox.com/scl/fi/9mj59587ct2671jxly0zc/sub.xlsm?dl=0&rlkey=3r8j1456748bmn4a0tg28mbud
Related:

3 responses

Answer 1 / 3
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Sep 21, 2021 at 11:49 AM
Hi Hasson,

It can be frustating when an OP alters the query, but I'm pretty sure that it's not OP's intent to waste anyone's time.

On to your questions:
  • Yes I got your file.
  • The code I provided was supposed to be run after the Substract_Likes code, to update the numbers on the RS sheet.


Let me post back your file. I made 2 adjustments to the Subtract_Likes code. These 2 points were just anoying me: Autofitting the rows and disabling the message about replacing the data.

Here is your file:
https://wetransfer.com/downloads/1d473cab2c4cc2ab61637059dc9dc27b20210921154900/79a11e

You can run both codes individually after each other or run RunBothCodes.

Best regards,
Trowa
1
Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022
Sep 22, 2021 at 09:27 AM
thanks .I appreciate your assistance . actually the code in module 1 doesn't still subtract repeatd data. take row1 gives 7 , but it should give 2 as your code in module2, may you check it please?
best regards,
Hasson
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555 > Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022
Sep 23, 2021 at 11:00 AM
Hi Hasson,

After running the code in module 1, the top result is wrongly 7. After running the code in module 2, the top result is correctly updated to 2.

The code in module 1 is still the same code with the 2 adjustments mentioned in the previous post. The code I added in module 2 updates the numbers on the RS sheet. For convenience sake I added the macro RunBothCodes, hit ALT+F8 and double click RunBothCodes to get the right result immediately.

Are you saying that after you run both codes you still get the wrong results?

Best regards,
Trowa
0
Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022 > TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022
Updated on Sep 23, 2021 at 11:10 AM
Hi Trowa,
Are you saying that after you run both codes you still get the wrong results?
no. the second code works and gives right value . but I thought to you adjusted the first code.
the first code has advantage create whole data . but your code doesn't do that. I have to write the data manually and bring the values , if I have a big data then it will take from me more time to writing . I know the first code is complicated and not to easy to mod . actually I appreciate your assistance .
thanks again
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555 > Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022
Sep 23, 2021 at 11:37 AM
Hi Hasson,

It seems you have an issue with running 2 codes ...

I fail to see the problem; Use the module 1 code to bring in the data, so you DON'T have to write the data manually. Use the module 2 code to get the right numbers, so you DON'T have to recalculate manually.

So yeah, the first code creates the whole data, but get the numbers wrong. My code doesn't create the whole data, but gets the numbers right. Both codes support each other to create the desired result.

Am I missing something?

Best regards,
Trowa
0
Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022 > TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022
Sep 23, 2021 at 11:51 AM
Hi Trowa,
ah! I got it . I have to depend on two codes together . I thought to choose one code to do all of things .
smart work !
thanks so much for your assistance
0
Answer 2 / 3
Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022
Sep 13, 2021 at 10:31 PM
is there any help?
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Updated on Sep 14, 2021 at 12:20 PM
Hi Hasson,

The code uses a lot of stuff I'm not familiar with and I wanted to understand it as it is very efficient. It just takes longer then I thought.

In the mean time, let me provide you with an additional code to get the correct numbers: 
Sub RunMe()
Dim mFind As Range
Dim mCount As Long

Sheets("RS").Select
For Each cell In Range("D2:D17")
    Set mFind = Sheets("Keys out").Columns("B").Find(cell.Value)
    If Not mFind Is Nothing Then
        firstaddress = mFind.Address
        Do
            If cell.Offset(0, 1).Value & cell.Offset(0, 2).Value = mFind.Offset(0, 1).Value & mFind.Offset(0, 2).Value Then
                mCount = mCount + mFind.Offset(0, 3).Value
            End If
            Set mFind = Sheets("Keys out").Columns("B").FindNext(mFind)
        Loop While mFind.Address <> firstaddress
    End If
    Set mFind = Sheets("SH").Columns("E").Find(cell.Value)
    If Not mFind Is Nothing Then
        firstaddress = mFind.Address
        Do
            If cell.Offset(0, 1).Value & cell.Offset(0, 2).Value = mFind.Offset(0, 1).Value & mFind.Offset(0, 2).Value Then
                mCount = mCount - mFind.Offset(0, 3).Value
            End If
            Set mFind = Sheets("SH").Columns("E").FindNext(mFind)
        Loop While mFind.Address <> firstaddress
    End If
    cell.Offset(0, 3).Value = mCount
    mCount = 0
Next cell
   
End Sub


The code seems tailor made for you. Can't you ask the one that wrote the code for you to alter it?

Best regards,
Trowa
0
Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022 > TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022
Sep 15, 2021 at 01:59 PM
Hi Trowa,
first thanks for try providing me another solution . but unfortnutly it doesn't subtract and gives minus values . the orginal code creates whole data in sheet RS , but your code and before subtract the values . I have to write data from COL A: F and match the data .then subtract and show the values in COL G, am I right about your code?
I no know if you saw my file and some comments and highlighted cells in all sheets
if this is not clear . I will provide more detailes
thanks for your help
0
Answer 3 / 3
Hasson_6770 Posts 18 Registration date Monday August 2, 2021 Status Member Last seen May 23, 2022
Updated on Sep 14, 2021 at 12:32 PM
Hi Trowa,
The code seems tailor made for you. Can't you ask the one that wrote the code for you to alter it?
you 're extremely right . actually I did it and ask for him repeatedly . but it doesn't seem to answer me because I don't make clear my requirments from the beggining .despite of he adjust many codes for others members but about my case ignores me totally that's why I search for another body to help me . I barly lose my mind I don't find solution so far .
about your code I will test it and inform you as soon possible
thanks for your help
0

Similar discussions

lava hard reset & factory reset
AVAY -
Har -

3 responses
Unlock code
Wwe -
Sahilkarate -

1 response