• 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.

Reducing and facilitating the handling of the file

Hany ali

Active Member
Dear my Masters
I want Your Help in this File ..because This is an annual entry file and the entries may exceed 3000 rows ..Very heavy when dealing with it and entering a Main page to Transfer it to the rest of the pages of the file based on the name of the company in the third column C of this page ,, This is because a Main page contains equations with two columns G & H and also contains drop-down lists for the rest of the columns ..s there a solution to make the file lower than that when dealing with it... Thank you very much ?
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
            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
                  Else
                  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

  • Transportation For Multiple Companies-2021.xlsb
    343.4 KB · Views: 3
Back
Top