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"
Value on the main sheet should be calculated respect to months
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