Ytdyklly

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"

Sheet1

Sheet2

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