92C degrees temp when running macros LOL

[ilovepizza82]

Hi,

HAve you ever checked temp. of you CPU when running macros in excell ?
Mine reached 92C degrees today lol and stayed at around 90C for a while untill the macro done its job.
Apprx. 1200 rows, 87 columns.

My setup:
I7 10700, Win10, Cooling System: Arctic Duo 34 (in the screenshot). One of the most efficient cooling systems out there.
I dont even want to try to imagine how bad it would have been if I had used Intel stock fan...brrr

[ShaunWhite]

Mine rarely gets above 80. Similar spec fans to yours but that doesn't help if the box isn't letting air through. I have the side furthest away from me off completely, gets dusty as hell but that gets hovered out regularly. I bought some 200mm Noctua Chromax fans for a side project, jeez they shift some air and are so quiet! So maybe get the jigsaw out and make a hole in the side of your case and stick one of those in.

[Crazyskier]

I use Intel(R) Core(TM) i7-9700K CPU @ 3.60GHz with a Cooler Master water cooling system for my main desktop . Just a thought if you are struggling with fan cooling consistently.

CS

[The Silk Run]

I use my computer fans to dry my painted nails, worx great !!!

[ODPaul82]

It shouldn't get to that temperature which means that you're running poorly written code that is going through a hell of a lot more iterations then it should be

[ilovepizza82]

@Shaun, I already have in there like 999 fans At least it feels like it.
If i add another fan in there that will make 1000 fans
@Crazyskier, Good advice but Ive just bought that one above and also I read a lot that water pump is a dangerous thing to have when it fails. It may seriously damage your CPU when it does fail and i read they break very often so i dont know. How long have you had yours ?
@The Silk Run, I like your creativity

[ilovepizza82]

It shouldn't get to that temperature which means that you're running poorly written code that is going through a hell of a lot more iterations then it should be

It is not possible.
My macro is an ultimate bad ass, state of the bad ass art.

Sub InsertRowsAtIntervals()
Dim Rng As Range
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet
xTitleId = "Blablabla"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Set xWs = WorkRng.Parent
For i = 1 To Int(xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
Next
End Sub

[ODPaul82]

My lord I need a stiff drink after looking at that

Without re-writing the whole thing for you (which is tempting), look into building up a range object with the Union function in VBA rather than inserting all of them one at a time, that's what's killing you
If you do it one hit then it should be a hell of a lot faster and your CPU will be buying you drinks

As a very quick fix look at disabling events and screenupdating at the start of your code
Also dont forget to turn them back on at the bottom

Code: Select all

Application.EnableEvents = False
Application.ScreenUpdating = False

Me nit-picking
You declared variables - Yay!
You didn't declare all of them, xTitleId will be set in memory as a variant, as will 'i' as you didn't declare that
You don't need to put Application before InputBox
VBA doesn't do garbage collection of unused objects (no dont visualise bins being picked up off the street) so at the bottom of the code do

Code: Select all

Set WorkRng = Nothing
Set xWs = Nothing

Sanity check your inputs for example if you try and store a bit of text into xInterval or xRows then it's going to start crying

Code: Select all

strInput = InputBox("Enter row interval", xTitleId, 1)
    If IsNumeric(strInput) Then xInterval = CLng(strInput)
    If xInterval > 0 Then
    	.... do your magic here
    End If
 

[Crazyskier]

@Crazyskier, Good advice but Ive just bought that one above and also I read a lot that water pump is a dangerous thing to have when it fails. It may seriously damage your CPU when it does fail and i read they break very often so i dont know. How long have you had yours ?

The cooler master one I use is tried and tested in the gaming community. It's fully sealed with no top-ups required and a very, very low fail rate.I do a lot of gaming with a GEFORCE RTX (ray-tracing) graphics card which was recommended with water cooling for my gaming desktop - which I also use for multiple automation instances open at one time. It's served me well for around 18 months thus far.

CS

[ilovepizza82]

My lord I need a stiff drink after looking at that

Without re-writing the whole thing for you (which is tempting), look into building up a range object with the Union function in VBA rather than inserting all of them one at a time, that's what's killing you
If you do it one hit then it should be a hell of a lot faster and your CPU will be buying you drinks

As a very quick fix look at disabling events and screenupdating at the start of your code
Also dont forget to turn them back on at the bottom

Code: Select all

Application.EnableEvents = False
Application.ScreenUpdating = False

Me nit-picking
You declared variables - Yay!
You didn't declare all of them, xTitleId will be set in memory as a variant, as will 'i' as you didn't declare that
You don't need to put Application before InputBox
VBA doesn't do garbage collection of unused objects (no dont visualise bins being picked up off the street) so at the bottom of the code do

Code: Select all

Set WorkRng = Nothing
Set xWs = Nothing

Sanity check your inputs for example if you try and store a bit of text into xInterval or xRows then it's going to start crying

Code: Select all

strInput = InputBox("Enter row interval", xTitleId, 1)
    If IsNumeric(strInput) Then xInterval = CLng(strInput)
    If xInterval > 0 Then
    	.... do your magic here
    End If
 

lol thanks
However when i put some of your code bits I didnt notice any performance improvement but i think im doing something wrong here to be honest and also not working working properly. It doesnt allow me to select range. I mean there is a pop up window but I cannot manualy select my range (mouse framing) like in the screenshot which is very annoying.

[ilovepizza82]

@Crazyskier, Good advice but Ive just bought that one above and also I read a lot that water pump is a dangerous thing to have when it fails. It may seriously damage your CPU when it does fail and i read they break very often so i dont know. How long have you had yours ?

The cooler master one I use is tried and tested in the gaming community. It's fully sealed with no top-ups required and a very, very low fail rate.I do a lot of gaming with a GEFORCE RTX (ray-tracing) graphics card which was recommended with water cooling for my gaming desktop - which I also use for multiple automation instances open at one time. It's served me well for around 18 months thus far.

CS

Thanks CS Ill have a look.

[ODPaul82]

Try giving the following a whirl, the premise is to copy the cells that you have selected into memory, reserve a seperate section of memory plus whatever the additional gaps & intervals are then shifts the data to the newly reserved part but just jumping when it hits an interval

Code: Select all

Sub InsertSpacing()

    Dim lngGaps As Long
    Dim lngInterval As Long
    Dim strInput As String
    Dim varValues() As Variant
    Dim varOutput() As Variant
    Dim rOut As Long, lngInterCnt As Long
    Dim r As Long, c As Long
    Dim objOutputRng As Excel.Range
    Dim lngRows As Long
    
    lngInterval = mlngSanityCheck("Enter row interval:")
    lngGaps = mlngSanityCheck("How many rows to insert at each interval:")

    varValues = Selection.Value
    
    ' Calculate size new array needs to be
    lngRows = UBound(varValues, 1) + ((lngInterval * lngGaps) * 2)
    ReDim varOutput(1 To lngRows, 1 To UBound(varValues, 2))
    
    rOut = 1
    lngInterCnt = 1
    For r = LBound(varValues, 1) To UBound(varValues, 1)
    
        For c = LBound(varValues, 2) To UBound(varValues, 2)
        
            varOutput(rOut, c) = varValues(r, c)
        
        Next c
    
        If lngInterCnt = lngInterval Then
            rOut = rOut + lngGaps + 1
            lngInterCnt = 1
        Else
            rOut = rOut + 1
            lngInterCnt = lngInterCnt + 1
        End If
    
    Next r

    
    ' get first cell in range, resize to be size of array and paste
    Set objOutputRng = ActiveCell
    Set objOutputRng = objOutputRng.Resize(rOut - 1, UBound(varValues, 2))
    objOutputRng.Value = varOutput
    Set objOutputRng = Nothing
End Sub


' Returns 1 if invalid value entered
Private Function mlngSanityCheck(ByVal pstrPrompt As String) As Long

    Dim strInput As String
    Dim lngRtn As Long
    
    strInput = InputBox(pstrPrompt, , 1)
    
    If IsNumeric(strInput) Then
        lngRtn = CLng(strInput)
        If lngRtn < 1 Then lngRtn = 1
        mlngSanityCheck = lngRtn
    
    Else
        mlngSanityCheck = 1
    
    End If

End Function