Correction of the vba code

https://www.experts-exchange.com/questions/29115581/Copy-and-paste-the-data-by-add-subtract-by-percentage.html
https://www.experts-exchange.com/questions/29115579/Conditionally-copy-and-paste-of-the-data-with-add-subtract-method.html
Plz have a look in this post
when i run the code  one after another  then they are deleting the previous data
Plz look into it and do needful
Sub STEP8_2()
Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim x2, x3, x4, arrG(), dict
Dim i As Long, lr As Long

Application.ScreenUpdating = False

Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
lr = ws4.Cells(Rows.Count, 1).End(xlUp).Row
x2 = ws2.Range("A1").CurrentRegion.Value
x3 = ws3.Range("A1").CurrentRegion.Value
x4 = ws4.Range("A1:T" & lr).Value
ReDim arrG(1 To UBound(x4, 1), 1 To 1)

Set dict = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(x2, 1)
    dict.Item(x2(i, 2)) = x2(i, 13) & "_" & Round(x2(i, 4) * 1.005, 2)
Next i

For i = 2 To UBound(x3, 1)
    dict.Item(x3(i, 2)) = x3(i, 13) & "_" & Round(x3(i, 4) * (1 - 0.005), 2)
Next i

For i = 1 To UBound(x4, 1)
    If dict.exists(x4(i, 3)) Then
        If x4(i, 10) = Split(dict.Item(x4(i, 3)), "_")(0) Then
            arrG(i, 1) = Split(dict.Item(x4(i, 3)), "_")(1)
        End If
    End If
Next i
ws4.Range("G1").Resize(UBound(x4, 1), 1).Value = arrG
Application.ScreenUpdating = True
End Sub

Open in new window


Sub STEP8()
Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim x2, x3, x4, arrG(), arrL(), dict
Dim i As Long, lr As Long

Application.ScreenUpdating = False

Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
lr = ws4.Cells(Rows.Count, 1).End(xlUp).Row
x2 = ws2.Range("A1").CurrentRegion.Value
x3 = ws3.Range("A1").CurrentRegion.Value
x4 = ws4.Range("A1:T" & lr).Value
ReDim arrG(1 To UBound(x4, 1), 1 To 1)
ReDim arrL(1 To UBound(x4, 1), 1 To 1)

Set dict = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(x2, 1)
    dict.Item(x2(i, 2)) = x2(i, 13) & "_" & x2(i, 4) & "_" & x2(i, 4) - 0.05
Next i

For i = 2 To UBound(x3, 1)
    dict.Item(x3(i, 2)) = x3(i, 13) & "_" & x3(i, 4) & "_" & x3(i, 4) + 0.05
Next i

For i = 1 To UBound(x4, 1)
    If dict.exists(x4(i, 3)) Then
        If x4(i, 10) <> Split(dict.Item(x4(i, 3)), "_")(0) Then
            arrL(i, 1) = Split(dict.Item(x4(i, 3)), "_")(1)
            arrG(i, 1) = Split(dict.Item(x4(i, 3)), "_")(2)
        End If
    End If
Next i
ws4.Range("G1").Resize(UBound(x4, 1), 1).Value = arrG
ws4.Range("L1").Resize(UBound(x4, 1), 1).Value = arrL
Application.ScreenUpdating = True
End Sub

Open in new window




First code is perfect for getting  percentage  No issues with the first code
Second code is creating issues second code is  removing the data from column G and L column
I already have data in column G and L and i will run the code  & it should not  affect any data in any column and in column G and column L while doing the process
So it is my request plz look into it
TwoClick.xlsb
TwoClick.xlsb
Sachin SinghAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
So will you always run the macro STEP8_2 first to place the percentage values in column G and then run the macro Step8 to place the amounts in column G and column L but you want to retain any existing values in column G if any. Right?
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Also is it not better to call both these macros from another macro in sequence like below?

Sub PopulateColumnGAndL()
    Call STEP8_Percentage
    Call STEP8
End Sub

Open in new window

So that when macro PopulateColumnGAndL is run, it will call STEP8_Percentage macro first and then call the macro STEP8.
0
Sachin SinghAuthor Commented:
Neeraj Sir first i will run percentage code and then second one
And while doing all the process we don't have to change any data  affect any data and we have to complete the process
0
10 Tips to Protect Your Business from Ransomware

Did you know that ransomware is the most widespread, destructive malware in the world today? It accounts for 39% of all security breaches, with ransomware gangsters projected to make $11.5B in profits from online extortion by 2019.

Sachin SinghAuthor Commented:
Yes Neeraj Sir i want to retain that data
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
So what about the second option I gave you i.e. run both the code in sequence by clicking the one button only?
0
Sachin SinghAuthor Commented:
Neeraj Sir but the second code is creating issue it is removing the data in column G and L
We have to edit the code so that it can't affect the data
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
I tweaked the code STEP8 like below...

Sub STEP8()
Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim x2, x3, x4, arrG(), arrL(), dict
Dim i As Long, lr As Long

Application.ScreenUpdating = False

Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
lr = ws4.Cells(Rows.Count, 1).End(xlUp).Row
x2 = ws2.Range("A1").CurrentRegion.Value
x3 = ws3.Range("A1").CurrentRegion.Value
x4 = ws4.Range("A1:T" & lr).Value
ReDim arrG(1 To UBound(x4, 1), 1 To 1)
ReDim arrL(1 To UBound(x4, 1), 1 To 1)

Set dict = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(x2, 1)
    dict.Item(x2(i, 2)) = x2(i, 13) & "_" & x2(i, 4) & "_" & x2(i, 4) - 0.05
Next i

For i = 2 To UBound(x3, 1)
    dict.Item(x3(i, 2)) = x3(i, 13) & "_" & x3(i, 4) & "_" & x3(i, 4) + 0.05
Next i

For i = 1 To UBound(x4, 1)
    If x4(i, 7) <> "" Then
        arrG(i, 1) = x4(i, 7)
    Else
        If dict.exists(x4(i, 3)) Then
            If x4(i, 10) <> Split(dict.Item(x4(i, 3)), "_")(0) Then
                arrL(i, 1) = Split(dict.Item(x4(i, 3)), "_")(1)
                arrG(i, 1) = Split(dict.Item(x4(i, 3)), "_")(2)
            End If
        End If
    End If
Next i
ws4.Range("G1").Resize(UBound(x4, 1), 1).Value = arrG
ws4.Range("L1").Resize(UBound(x4, 1), 1).Value = arrL
Application.ScreenUpdating = True
End Sub

Open in new window


In the attached, you may click the button called "Populate Column G & L With Percentage and Amount" to place both the percentage and the amount in column G and L.

If you wish you can still run both the macros individually. Both the macros are placed on Module1.
TwoClick-v4.xlsb
0
Sachin SinghAuthor Commented:
Now i understood u r missing this info
plz see my 2nd sample file that i have attached in that file in sheet4 plz see column L and there is already data in Column L NA
so we dont have to remove that NA  i want that also
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Okay, let me know if the attached works for you.
TwoClick-v4.xlsb
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Sachin SinghAuthor Commented:
Ur r Right Neeraj Sir Now it's perfect
Thnx Neeraj Sir for ur great support
But i need info if i have to increase or decrease the percentage  what correction i have to made so in future if change is required i will do the changes
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
In the first code you posted in your description, line#20 and 24 calculates the percentage values.

dict.Item(x2(i, 2)) = x2(i, 13) & "_" & Round(x2(i, 4) * 1.005, 2)

dict.Item(x3(i, 2)) = x3(i, 13) & "_" & Round(x3(i, 4) * (1 - 0.005), 2)

Where 0.5% is equivalent to .005.
0
Sachin SinghAuthor Commented:
Thnx Neeraj Sir for the info
Have a Great Day
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Thanks & you too!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.