Set the code to convert equations into code to speed up and reduce the file

Hany ali

Active Member
Hello My Dear .. I want Your Help to Modification this Code to work efficiently ,because when i make Run For This Code to just Bring First Row From Data I want to Get all Data From anothe Page Basic .and every day i get data to this File ..and please i want when i make Run for this Code to work only for New data Which i get it Daily. and Ignor Old Data because As You See I has some Data I Put It Manuel from Column N TO Column Q From Sheet2 Page and i don't need to work every time Twice
Code:
``````Option Explicit
Sub Macro1()
Dim Ws As Worksheet, lr As Long
Application.EnableEvents = 0
Application.ScreenUpdating = 0
Set Ws = ThisWorkbook.Sheets("Sheet2")
With Ws
lr = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A2:a" & lr).Formula = "=IFERROR(INDEX(Basic!\$A\$2:\$A\$3000,MATCH(0,INDEX(COUNTIF(\$A\$1:A1,Basic!\$A\$2:\$A\$3000),),0)),"""")"
.Range("b2:b" & lr).Formula = "=IF(OR(\$A2="""",\$A2=0),"""",SUMIF(Basic!\$A:\$A,\$A2,Basic!\$B:\$B))"
.Range("c2:c" & lr).Formula = "=IF(OR(\$A2="""",\$A2=0),"""",SUMIF(Basic!\$A:\$A,\$A2,Basic!\$c:\$c))"
.Range("d2:d" & lr).Formula = "=IF(OR(\$A2="""",\$A2=0),"""",SUMIF(Basic!\$A:\$A,\$A2,Basic!\$d:\$d))"
.Range("e2:e" & lr).Formula = "=IF(OR(\$A2="""",\$A2=0),"""",VLOOKUP(\$A2,Basic!\$A\$2:\$R\$407,5,0))"
.Range("g2:g" & lr).Formula = "=IF(OR(\$A2="""",\$A2=0),"""",VLOOKUP(\$A2,Basic!\$A\$2:\$R\$407,7,0))"
.Range("h2:h" & lr).Formula = "=IF(OR(\$A2="""",\$A2=0),"""",SUMIF(Basic!\$A:\$A,\$A2,Basic!\$R:\$R))"
.Range("i2:i" & lr).Formula = "=IF(VLOOKUP(\$A2,Basic!\$A\$2:\$R\$407,9,0)=0,"""",VLOOKUP(\$A2,Basic!\$A\$2:\$R\$407,9,0))"
.Range("j2:j" & lr).Formula = "=IF(\$E2=""Individual Luxor"",\$B2*VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$E\$200,4,0)+\$C2*VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$E\$200,5,0),IF(OR(\$B2="""",\$C2=""""),"""",IF(OR(LEFT(\$E2,10)=""Individual"",LEFT(\$E2,7)=""Private"",LEFT(\$E2,12)=""Professional""),VLOOKUP(\$F2&\$E2,Data!\$A\$3:\$D\$200,4,0),\$B2*VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$E\$200,4,0)+\$C2*VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$E\$200,5,0))))"
.Range("k2:k" & lr).Formula = "=IFERROR(VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$J\$200,10,0)+\$O2*VLOOKUP(\$E2,Data!\$T\$66:\$W\$80,MATCH(\$P2,Data!\$T\$66:\$W\$66,0),0),0)"
.Range("l2:l" & lr).Formula = "=IFERROR(\$B2*VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$H\$200,8,0)+\$C2*VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$H\$200,8,0)/2,"""")"
.Range("m2:m" & lr).Formula = "=IF(\$B2="""","""",VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$F\$200,6,0))"
.Range("t2:t" & lr).Formula = "=IFERROR(IF(AND(\$N2=""Sempre Travel"",OR(\$E2=""Luxor Over Day"",\$E2=""Cairo Over Day Deluxe"",\$E2=""Cairo Overday HRG"",\$E2=""Cairo/Alex 2 Night"",\$E2=""Luxor Over Day Deluxe"",\$E2=""Luxor Open Museum"",\$E2=""Individual Luxor"")),S2-(S2*10%)+(R2-(R2*10%))+((R2-(R2*10%))*11%),IF(AND(\$F2=""Red Sea Sky"",\$P2=""Supplier""),\$R2-(\$R2*3%),IF(AND(\$F2=""Fanadir Aqua Center"",\$P2=""Supplier""),\$R2-(\$R2*3%),IF(\$P2=""Supplier"",\$R2+(\$R2*11%),IF(\$N2=""Spring Tours"",\$R2+(\$R2*14%)+\$S2,S2-(S2*10%)+(R2-(R2*10%))+((R2-(R2*10%))*11%)))))),"""")"
.Range("u2:u" & lr).Formula = "=IFERROR(\$B2*VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$K\$200,11,0)+\$C2*VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$K\$200,11,0)/2,"""")"
.Range("v2:v" & lr).Formula = "=IFERROR(IF(\$E2=""Sondos Turkish Bath"",\$H2-(\$H2*5%)-((\$J2-0)/\$AB\$1),IF(AND(\$F2=""Sovana"",\$P2=""Supplier""),\$H2-(\$H2*5%)+(0)-(\$J2+\$K2+\$T2),IF(\$M2=""L.E"",\$H2-(\$H2*5%)+(0/\$AB\$1)-(\$J2+\$K2+\$T2)/\$AB\$1,IF(AND(\$E2=""Grand Aquarium"",\$P2=""Supplier""),\$H2-(\$H2*5%)+(0)-(\$J2+\$K2+\$T2),\$H2-(\$H2*5%)+(0)-(\$J2+\$K2+(\$T2/\$AB\$1)))))),"""")-\$U2"
.Range("w2:w" & lr).Formula = "=IFERROR(IF(\$I2<>"""",VLOOKUP(\$F2&\$E2&\$I2,Data!\$A\$3:\$I\$2000,9,0),VLOOKUP(\$F2&\$E2,Data!\$A\$3:\$I\$2000,9,0)),"""")"
.Range("z2:z" & lr).Formula = "=IFERROR(\$B2*VLOOKUP(\$E2,Data!\$T\$67:\$Z\$100,6,0)+\$C2*VLOOKUP(\$E2,Data!\$T\$67:\$Z\$100,7,0),"""")"
.Range("aa2:aa" & lr).Formula = "=IF(AND(\$M2=""\$"",\$F2<>""Yellow SeaScope"",\$P2=""Supplier""),\$H2-(\$H2*5%)-(J2+K2+T2+U2),IF(\$M2=""L.E"",\$H2-(\$H2*5%)-\$U2-((J2+K2+T2)/\$AB\$1),\$G2-(\$G2*5%)-\$U2-J2-((K2+T2+U2)/\$AB\$1)))"
.Range("a2:aa" & lr).Value = .Range("a2:aa" & lr).Value
Application.EnableEvents = 1
Application.ScreenUpdating = 1
End With
End Sub``````

Attachments

• 156.2 KB Views: 5
• 13 KB Views: 2
Last edited:

vletm

Excel Ninja
Hany ali
You should try to sell Your thread by giving something new details ... or wait.

Hany ali

Active Member
thanks alot my Dear
vletm
The file has been updated and made all manual inputs on the Basic page, which is transfer data sheet2 by the Equation in Sheet2 page if you can find a better way to Transfer data to Sheet2 page until the file becomes easier
the transfer way based on the equation in Column A From Basic Sheet with the equation A from another page in Sheet2
Note: If you can Delete The File From Post #1 and change it with this New File?

Attachments

• 278.3 KB Views: 6
Last edited:

Hany ali

Active Member
Is there something not clear about what is required?
The mechanism of this file is based on the equation in column A of the Basic page, which is:
Code:
``=IF(\$X2="By Supplier",\$E2&\$G2&\$I2&\$M2&\$X2,\$E2&\$G2&\$I2&\$X2)``
Then the following equation is used and placed in column A on Sheet2 starting from cell A2 to fetch the results of the equation on the other page without repeating
Code:
``=IFERROR(INDEX(Basic!\$A\$2:\$A\$801,MATCH(0,INDEX(COUNTIF(\$A\$1:A1,Basic!\$A\$2:\$A\$801),),0)),"")``
I have come up with this code and put it in a Basic Sheet
Code:
``````Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
k = MsgBox("Do you want to update ? ", vbYesNo, "Update")
If k = vbNo Then Exit Sub
Sheets("Basic").Range("A2").AutoFill Destination:=Sheets("Basic").Range("A2:A800"), Type:=xlFillDefault
Sheets("Basic").Range("A3:A800") = Sheets("Basic").Range("A3:A800").Value
Application.ScreenUpdating = True
End Sub``````
and this Code in Sheet2 Page
Code:
``````Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
k = MsgBox("Do you want to update ? ", vbYesNo, "Update")
If k = vbNo Then Exit Sub
Sheets("sheet2").Range("A2:w2").AutoFill Destination:=Sheets("sheet2").Range("A2:W500"), Type:=xlFillDefault
Sheets("sheet2").Range("A3:W500") = Sheets("sheet2").Range("A3:W500").Value
Application.ScreenUpdating = True
End Sub``````
May God bless you all. Is it not possible to solve this problem with a code that does not update the data that has been migrated and modified previously in Sheet2 Page, and only migrates the newly entered data and any change in Basic Sheet?!!

Attachments

• 31.8 KB Views: 1
Last edited:

Hany ali

Active Member
Dear All ...Is there an easier and lighter solution than this previous solution ?!