Calculate Data from difference cells with Macro-CodePudding

l am trying to build a worksheet to collect and SUM data from a workbook (with macro) file . The data l need is combined from many difference cells in 1 sheet of the workbook, then l will display the result with "value only format".

Can you help me to short the code and make it run faster please. The workbook where l collect data is Test.xlsm and l have around 30 items. Many thanks

The codes below is what l did.

Sub Test1()
'
' Test1 Macro
   
    Dim Slaw150 As Variant
    Dim Slaw200 As Variant
    Dim Slaw300 As Variant
    Dim Slaw400 As Variant
    
    Slaw150 = "=SUM('[Test.xlsm]Test'!$CO$66:$CS$66,'[Test.xlsm]Test'!$CO$88:$CS$88,'[Test.xlsm]Test'!$CO$95:$CS$95)"
    Slaw200 = "=SUM('[Test.xlsm]Test'!$CO$67:$CS$67,'[Test.xlsm]Test'!$CO$89:$CS$89,'[Test.xlsm]Test'!$CO$96:$CS$96)"
    Slaw300 = "=SUM('[Test.xlsm]Test'!$CO$68:$CS$68,'[Test.xlsm]Test'!$CO$90:$CS$90,'[Test.xlsm]Test'!$CO$97:$CS$97)"
    Slaw400 = "=SUM('[Test.xlsm]Test'!$CO$69:$CS$69,'[Test.xlsm]Test'!$CO$91:$CS$91,'[Test.xlsm]Test'!$CO$98:$CS$98)"
    
    With Range("C42")
        .Value = Slaw150
        .Value = .Value
    End With
    
    With Range("C43")
        .Value = Slaw200
        .Value = .Value
    End With
    
    With Range("C44")
        .Value = Slaw300
        .Value = .Value
    End With
      
End Sub

CodePudding user response：

Please, test the next way:

Sub TestSUMM()
   Dim sh As Worksheet, rngSUM As Range, arrSUM, i As Long
   
   Set sh = Workbooks("Test.xlsm").Sheets("Test")
   Set rngSUM = sh.Range("CO66:CS69,CO88:CS91,CO95:CS98") 'The whole discontinuous range
   ReDim arrSUM(1 To 4, 1 To 1)   'ReDim the array to keep processing result
   
   For i = 1 To rngSUM.rows.Count 'iterate between the discontinuous range rows and summarize them:
        arrSUM(i, 1) = WorksheetFunction.Sum(rngSUM.rows(i))
   Next i
   
   sh.Range("I41").Resize(4).Value = arrSUM 'drop the array content at once
End Sub