kelly mort
Well-known Member
- Joined
- Apr 10, 2017
- Messages
- 2,169
- Office Version
- 2016
- Platform
- Windows
I need to get these codes run in memory for the various processes, before placing the result onto the sheet instead on interacting with the sheet for all the events. As my data grows, it seems to be slowing down my codes.
This post was inspired by @DanteAmor solution at:
Any of them that I get solution for, I will really appreciate that. I am working on effective ways to run my scripts faster by using better optimization techniques. Thanks in advance for taking the time, pain and effort to read this.
Script #1
Script #2
Script #3
This post was inspired by @DanteAmor solution at:
Load part of data to memory, perform some calculations and rank then show alert with message box -vba
This is the formula I am using to get data to second sheet. Sheet2.Range("D7:M" & lr) = "=Sheet1!I7+Sheet1!S7*0.2" Sheet1 Sheet2 Now what I want to do is to be able to load the portion of data from sheet2 for say category "X" into memory. Now I don't want to interact with the worksheet...
www.mrexcel.com
Any of them that I get solution for, I will really appreciate that. I am working on effective ways to run my scripts faster by using better optimization techniques. Thanks in advance for taking the time, pain and effort to read this.
Script #1
Code:
Sub RankIt()
Dim dicSection As Object, vItem, wsData As Worksheet, vSection
Dim rScore As Range, rCell As Range, Score, Rnk#, lastrow&, i&
Application.ScreenUpdating = False
Set wsData = Sheets("DATA")
If wsData.FilterMode Then wsData.ShowAllData
lastrow = wsData.Cells(Rows.Count, "C").End(xlUp).Row
Set dicSection = CreateObject("Scripting.Dictionary")
dicSection.CompareMode = 1 'vbTextCompare
vSection = wsData.Range("C7:C" & lastrow)
For i = 1 To UBound(vSection)
dicSection(vSection(i, 1)) = ""
Next i
For Each vItem In dicSection.keys()
With wsData.Range("C6:N" & lastrow)
.AutoFilter field:=1, Criteria1:=vItem
For i = 1 To 11
Set rScore = .Offset(1, i).Resize(.Rows.Count, 1).SpecialCells(xlCellTypeVisible)
For Each rCell In rScore
Score = rCell.Value
If Application.IsNumber(Score) Then
Rnk = WorksheetFunction.Rank(CDbl(Score), rScore)
rCell.Offset(, 14).Value = Rnk & DefaultGetSuffix(Rnk)
End If
Next rCell
.AutoFilter
End With
Next vItem
Application.ScreenUpdating = True
End Sub
Function DefaultGetSuffix(Rnk#) As String
Dim sSuffix$
If Rnk Mod 100 >= 11 And Rnk Mod 100 <= 20 Then
sSuffix = " th"
Else
Select Case (Rnk Mod 10)
Case 1: sSuffix = " st"
Case 2: sSuffix = " nd"
Case 3: sSuffix = " rd"
Case Else: sSuffix = " th"
End Select
End If
DefaultGetSuffix = sSuffix
End Function
Script #2
Code:
Sub MySwitch()
For Each eItem In Range("C7:C" & lr).Cells
Select Case eItem.Text
Case 3: eItem = "Y 1"
Case 4: eItem = "Y 2"
Case 5: eItem = "X 1"
Case 6: eItem = "X 2"
Case 7: eItem = "X 3"
Case 8: eItem = "X 4"
Case 9: eItem = "X 5"
Case 10: eItem = "X 6"
Case 11: eItem = "Z 1"
Case 12: eItem = "Z 2"
Case 13: eItem = "Z 3"
End Select
Next eItem
End Sub
Script #3
Code:
Sub NumberEachCat()
Dim r As Range, counter&, currentS$
With Sheets("DATA")
lr = .Range("C" & Rows.Count).End(xlUp).Row
If lr < 7 Then lr = 7
currentS = .[A7].Value: counter = 1
For Each r In .Range("C7:C" & lr)
If currentS = r.Value Then
r.Offset(, -2) = counter
counter = counter + 1
Else
counter = 1
r.Offset(, -2) = counter
counter = counter + 1
currentS = r.Value
End If
Next r
End With
End Sub