Determine Max cores and set Excel process to use 1 less than max

Hi All,

I've built a bit of a monster excel application and really need to speed it up for some of our users who's desktops are both varied and in some cases a little on the low side in terms of CPU and RAM power.

I have used the code below to increase the priority of the application to HIGH which enables the users to get the data they require far far quicker and then hop out.

However this makes the system entirely unable for the few minutes the calculations take - is there a way to set to determine the number of cores the user has available and set the affinity to 1 less than max? we have a variety of dual, quad core and a couple of 8 core units so setting an arbitrary figure isn't an option.

(we're doing this manually to get a balance of both but it'd be nice to automate this step also)

Thank you.

CPU PRIORITY CODE:

 Declare Function GetCurrentProcessID Lib "kernel32" Alias "GetCurrentProcessId" () As Long


    Sub Change_PID_Priority()

    Const HIGH = 256
    Const ABOVE_NORMAL = 32768
    Const NORMAL = 32
    Const LOW = 64
    Const BELOW_NORMAL = 16384


    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

    Set colProcesses = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = 'EXCEL.EXE'")
    For Each objProcess In colProcesses
     'MsgBox objProcess.ProcessID
       
        If objProcess.ProcessID = GetCurrentProcessID Then
           objProcess.SetPriority (HIGH)
        End If

    Next

    End Sub