• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help reduce the weight of the file

Hany ali

Active Member
Hello ,Dear teachers, I ask you to facilitate the work on this file. The file is very heavy and working on it is very difficult. Please help me by adding the equations in column G of the Main Sheet.
Code:
=IFERROR($D3*@INDIRECT(ADDRESS(INDEX(MATCH($B3&$C3,Setting!$A$1:$A$74&Setting!$BB$1:$BB$74,0),),MATCH($F3,Setting!$B$1:$BA$1,0)+MATCH($E3,OFFSET(Setting!$B$2,0,0,1,MATCH($F3,Setting!$B$1:$BA$1,0)+9),0),,,"Setting")),"")
Also, the equation in column H of the code makes it easier to work on the file. Many thanks to you and may God bless your efforts. This is a very small sample of the file, as the file is very heavy.
Code:
=IFERROR($D3*@INDIRECT(ADDRESS(INDEX(MATCH($B3&$C3,Setting!$A$1:$A$74&Setting!$BB$1:$BB$74,0),),MATCH($F3,Setting!$B$1:$BA$1,0)+MATCH($E3,OFFSET(Setting!$B$2,0,0,1,MATCH($F3,Setting!$B$1:$BA$1,0)+9),0)+1,,,"Setting")),"")
Code:
Sub Test()
    Dim x, y, ws As Worksheet, sh As Worksheet, rng As Range, r As Long, M As Long
    Dim z As Long
    UseSpeedyCode True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
        Set ws = ThisWorkbook.Worksheets("Main")
        z = ws.Cells(Rows.Count, 1).End(xlUp).Row
        For r = 3 To z
            If Evaluate("ISREF('" & ws.Cells(r, 3).Value & "'!A1)") Then
                 Set sh = ThisWorkbook.Worksheets(ws.Cells(r, 3).Value)
                 M = sh.Cells(Rows.Count, 18).End(xlUp).Row + 1
                 C = WorksheetFunction.CountIfs(sh.Range("a3:a" & M), _
                 ws.Cells(r, 1), sh.Range("r3:r" & M), ws.Cells(r, 2))
                 If C > 0 Then GoTo 1
             sh.Cells(M, 1).Value = ws.Cells(r, 1).Value
                 sh.Cells(M, 18).Value = ws.Cells(r, 2).Value
                 sh.Cells(M, 19).Value = WorksheetFunction.SumIfs( _
                      ws.Range("g3:g" & z), ws.Range("a3:a" & z) _
                      , sh.Cells(M, 1).Value, ws.Range("b3:b" & z), _
                      sh.Cells(M, 18).Value, ws.Range("c3:c" & z), sh.Name)
                 sh.Cells(M, 20).Value = WorksheetFunction.SumIfs( _
                      ws.Range("h3:h" & z), ws.Range("a3:a" & z) _
                      , sh.Cells(M, 1).Value, ws.Range("b3:b" & z), _
                      sh.Cells(M, 18).Value, ws.Range("c3:c" & z), sh.Name)
                For x = 3 To 15 Step 4
                    For y = x - 1 To x + 2
                        sh.Cells(M, y).Value = WorksheetFunction.SumIfs( _
                             ws.Range("d3:d" & z), ws.Range("a3:a" & z), _
                             sh.Cells(M, 1).Value, ws.Range("b3:b" & z), _
                             sh.Cells(M, 18).Value, ws.Range("c3:c" & z), _
                             sh.Name, ws.Range("e3:e" & z), sh.Cells(1, x).Value, _
                             ws.Range("f3:f" & z), sh.Cells(2, y).Value)
                    Next
                Next

'                 sh.Cells(m, 19).Resize(1, 2).Value = ws.Cells(r, 7).Resize(1, 2).Value
'                 x = Application.Match(ws.Cells(r, 5).Value, sh.Rows(1), 0)
'                 If Not IsError(x) Then
'                    Set rng = sh.Cells(1, x).Offset(1, -1).Resize(1, 4)
'                    y = Application.Match(ws.Cells(r, 6).Value, rng, 0)
'                    If Not IsError(y) Then
'                        sh.Cells(m, x + y - 2).Value = ws.Cells(r, 4).Value
'                    End If
'                 End If
            End If
1
        Next r
    UseSpeedyCode False
     Application.Calculation = xlCalculationAutomatic
      MsgBox "Done...", 64
End Sub
Public Function UseSpeedyCode(goFast As Boolean)
    Dim calc As Long
    With Application
        .ScreenUpdating = Not goFast
        .EnableEvents = Not goFast
        If goFast Then
           ' calc = .Calculation
          '  .Calculation = xlCalculationManual
        Else
          '  .Calculation = calc
        End If
    End With
End Function
Sub Nor()
For x = 3 To 15 Step 4
For z = x - 1 To x + 2
MsgBox Cells(1, x)
MsgBox Cells(2, z)
Next
Next
End Sub
 

Attachments

  • Transport.xlsb
    49.7 KB · Views: 8
The file is difficult to handle while pasting daily data into it, as you can see
 

Attachments

  • Screenshot 2023-10-07 092409.png
    Screenshot 2023-10-07 092409.png
    18.6 KB · Views: 6
Back
Top