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.
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),,,"Setting")),"")
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