0
\$\begingroup\$

I have more than 20 sheets in Excel and one main sheet (all programs with 200 names). Each sheet has a column with names and 24 months (Jan 18 to Dec 18, Jan 19 to Dec 20). Each sheet names is a subset of the main sheet.

Main sheet (all programs) has 200 names and 24 months (values to be calculated based on other sheets). The other sheet has names and values for each month respective to the main sheet. I need to take each name in main sheet and search the name in all other sheets, and if present sum all same column values and insert in the main sheet.

For 1 name I need to do calculation on 34 cells (for 200 names * 34 cells = 6800 cells). It's taking almost 20 minutes with my code. Is there any other way I can do it or any modification which improves the performance?

Main Sheet has name "employee1"

enter image description here

Sheet1

enter image description here

Sheet2

enter image description here

Value on the main sheet should be calculated respect to months

enter image description here

Dim sheetCount As Integer
Dim datatoFind
Private Sub CommandButton1_Click()
 Dim mainSheet As String: mainSheet = "All Programs"
 Dim nameColumnStart As String: nameColumnStart = "A"
 Dim namesStart As Integer: namesStart = 1
 Dim namesEnd As Integer: namesEnd = 200
 Dim startColumn As Integer: startColumn = 10 'J Column'
 Dim EndColumn As Integer: EndColumn = 33 'AG Column'
 namesStart = InputBox("Please enter start value")
 namesEnd = InputBox("Please enter end value")
 Dim temp_str As String
 Dim total As Single
 On Error Resume Next
 Sheets(mainSheet).Activate
 lastRow_main = ActiveCell.SpecialCells(xlLastCell).Row
 lastCol_main = 34
 For vRow = namesStart To namesEnd
 temp_str = Sheets(mainSheet).Cells(vRow, "A").Text
 datatoFind = StrConv(temp_str, vbLowerCase)
 For vCol = startColumn To EndColumn
 total = Find_Data(vCol)
 Worksheets(mainSheet).Cells(vRow, vCol).Value = total
 Next vCol
 Next vRow
 Sheets(mainSheet).Activate
 'MsgBox ("Calculated all values")'
End Sub
Private Function Find_Data(ByVal ColumnName As Integer) As Single
 Dim counter As Integer
 Dim currentSheet As Integer
 Dim sheetCount As Integer
 Dim str As String
 Dim lastRow As Long
 Dim lastCol As Long
 Dim val As Single
 Find_Data = 0
 currentSheet = ActiveSheet.Index
 If datatoFind = "" Then Exit Function
 sheetCount = ActiveWorkbook.Sheets.Count
 For counter = 2 To sheetCount
 Sheets(counter).Activate
 lastRow = ActiveCell.SpecialCells(xlLastCell).Row
 lastCol = ActiveCell.SpecialCells(xlLastCell).Column
 For vRow = 1 To lastRow
 str = Sheets(counter).Cells(vRow, "A").Text
 If InStr(1, StrConv(str, vbLowerCase), datatoFind) Then
 val = Sheets(counter).Cells(vRow, ColumnName).Value
 Find_Data = Find_Data + val
 End If
 Next vRow
 Next counter
End Function
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked Jan 21, 2019 at 20:58
\$\endgroup\$
9
  • 3
    \$\begingroup\$ Welcome to Code Review! The current question title, which states your concerns about the code, applies to too many questions on this site to be useful. The site standard is for the title to simply state the task accomplished by the code. Please see How to Ask for examples, and revise the title accordingly. \$\endgroup\$ Commented Jan 21, 2019 at 21:02
  • 2
    \$\begingroup\$ I've removed the VBScript tag, since this is obviously VBA - and VBScript is a different language. What Toby means is that as it stands, the post's title is essentially "my code runs too slow, how do I make it faster" - which is a title that's applicable to pretty much 90% of the VBA questions on this site. So in order to avoid having a vba page filled with nearly-identical titles, we ask that you make your title a short description of what your code does, i.e. it's purpose. As the watermark says: "state the purpose of the code". Thanks \$\endgroup\$ Commented Jan 21, 2019 at 21:14
  • \$\begingroup\$ i changed the title for easy filtering . Thank you @m \$\endgroup\$ Commented Jan 21, 2019 at 21:21
  • 2
    \$\begingroup\$ That's.... literally the opposite of what I said. \$\endgroup\$ Commented Jan 21, 2019 at 21:33
  • \$\begingroup\$ Got it , I will change lol \$\endgroup\$ Commented Jan 22, 2019 at 3:47

1 Answer 1

1
\$\begingroup\$

Global Variables

Dim sheetCount As Integer
Dim datatoFind

Global variables make the code harder to maintain, modify, and debug. It would be better to pass the data as parameters between the sub routines. This makes it easier to determine exactly what data is being passed into your subroutines.

Private or Public modifiers should be used instead of Dim when declaring a global variable.

Constant Expressions

Dim mainSheet As String: mainSheet = "All Programs"
Dim nameColumnStart As String: nameColumnStart = "A"
Dim startColumn As Integer: startColumn = 10 'J Column'
Dim EndColumn As Integer: EndColumn = 33 'AG Column'

The variables above should be declared as constants.

Const mainSheet As String = "All Programs"
Const nameColumnStart As String = "A"
Const startColumn As Integer = 10 'J Column'
Const EndColumn As Integer = 33 'AG Column'

namesStart and namesEnd

Why initiate the values below if you are not going to use the initial values?

Dim namesStart As Integer: namesStart = 1
Dim namesEnd As Integer: namesEnd = 200
namesStart = InputBox("Please enter start value")
namesEnd = InputBox("Please enter end value")

Consider using Application.InputBox because you can specify the type of data it returns.

Dim namesStart As Integer
Dim namesEnd As Integer
Const namesStartDefault As Integer = 1
Const namesEndDefault As Integer = 200
namesStart = Application.InputBox(Prompt:="Please enter start value", Default:=namesStartDefault, Type:=1)
namesEnd = Application.InputBox(Prompt:="Please enter end value", Default:=namesEndDefault, Type:=1)
If namesStart < namesStartDefault Then
 MsgBox "Start vaule must be greater than or equal to " & namesStartDefault, vbCritical
 Exit Sub
End If

Selecting and Activating Objects

Selecting and Activating Objects should be avoided unless absolutely necessary, watch Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset). I would wager to bet that of the 20 minutes that it takes to run your code 19+ minutes are spent needlessly activating worksheets.

Using Application.ScreenUpdating = False would probably cut the time in half.

Function Find_Data

SpecialCells(xlLastCell) should only be used when you don't know the data structure.

lastCol isn't used.

 lastCol = ActiveCell.SpecialCells(xlLastCell).Column

vRow is never declared. The v prefix implies a variant when it should clearly be long.

ColumnName implies a string value. I would use CoumnIndex instead.

Refactored Code

Private Const mainSheet As String = "All Programs"
Private Sub CommandButton1_Click()
 Application.ScreenUpdating = False
 Const LastColumn = 34
 Dim namesStart As Integer
 Dim namesEnd As Integer
 Const namesStartDefault As Integer = 1
 Const namesEndDefault As Integer = 200
 namesStart = Application.InputBox(Prompt:="Please enter start value", Default:=namesStartDefault, Type:=1)
 namesEnd = Application.InputBox(Prompt:="Please enter end value", Default:=namesEndDefault, Type:=1)
 If namesStart < namesStartDefault Then
 MsgBox "Start vaule must be greater than or equal to " & namesStartDefault, vbCritical
 Exit Sub
 End If
 Dim r As Long, c As Long
 With ThisWorkbook.Worksheets(mainSheet)
 For r = namesStartDefault To namesEndDefault
 For c = 2 To LastColumn
 .Cells(r, c).Value = Find_Data(.Cells(r, 1).Value, c)
 Next
 Next
 End With
End Sub
Private Function Find_Data(ByVal EmployeeName As String, ByVal ColumnIndex As Integer) As Single
 Dim result As Single
 Dim ws As Worksheet
 Dim r As Long
 For Each ws In ThisWorkbook.Worksheets
 With ws
 If Not .Name = mainSheet Then
 For r = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
 If InStr(1, .Cells(r, 1).Value, EmployeeName, vbTextCompare) > 0 Then
 result = result + .Cells(r, ColumnIndex).Value
 End If
 Next
 End If
 End With
 Next
 Find_Data = result
End Function
answered Jan 23, 2019 at 8:53
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.