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 ?
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