Option Explicit Private Function GetColIndex(ByVal headerName As String, ByVal ws As Worksheet) As Long Dim lastCol As Long lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column Dim m As Variant m = Application.Match(headerName, ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)), 0) If IsError(m) Then GetColIndex = 0 Else GetColIndex = CLng(m) End If End Function Private Function BuildPresentColArray(ByVal headers As Variant, ByVal ws As Worksheet) As Variant Dim tmp() As Long ReDim tmp(0 To UBound(headers)) Dim i As Long, c As Long c = 0 For i = LBound(headers) To UBound(headers) Dim colIdx As Long colIdx = GetColIndex(CStr(headers(i)), ws) If colIdx > 0 Then tmp(c) = colIdx c = c + 1 End If Next i If c = 0 Then BuildPresentColArray = Array() Else Dim outArr() As Long ReDim outArr(0 To c - 1) For i = 0 To c - 1 outArr(i) = tmp(i) Next i BuildPresentColArray = outArr End If End Function Private Function MeanOfRow(ByVal ws As Worksheet, ByVal rowIndex As Long, ByVal colIndexes As Variant) As Variant Dim i As Long Dim sumVals As Double Dim countVals As Long sumVals = 0 countVals = 0 If IsArray(colIndexes) Then For i = LBound(colIndexes) To UBound(colIndexes) Dim v As Variant v = ws.Cells(rowIndex, CLng(colIndexes(i))).Value If Not IsError(v) Then If IsNumeric(v) Then sumVals = sumVals + CDbl(v) countVals = countVals + 1 End If End If Next i End If If countVals = 0 Then MeanOfRow = CVErr(xlErrNA) Else MeanOfRow = sumVals / countVals End If End Function Private Function EnsureOutputColumn(ByVal ws As Worksheet, ByVal headerName As String) As Long Dim c As Long c = GetColIndex(headerName, ws) If c = 0 Then Dim lastCol As Long lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column c = lastCol + 1 ws.Cells(1, c).Value = headerName End If EnsureOutputColumn = c End Function Sub BS_Means() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim all28 As Variant all28 = Array( _ "lock_T_easy", "hume_F_easy", "papy_T_easy", "sham_T_easy", "list_F_easy", "cons_T_easy", "tsun_T_easy", "pana_T_easy", "kabu_T_easy", "gulf_F_easy", "oedi_T_easy", "vaud_T_easy", "mont_F_easy", "demo_F_easy", _ "spee_F_hard", "dwar_F_hard", "carb_T_hard", "bohr_T_hard", "gang_F_hard", "vitc_F_hard", "hert_F_hard", "pucc_F_hard", "troy_T_hard", "moza_F_hard", "croc_F_hard", "gees_F_hard", "lute_F_hard", "memo_F_hard" _ ) Dim easy14 As Variant easy14 = Array( _ "lock_T_easy", "hume_F_easy", "papy_T_easy", "sham_T_easy", "list_F_easy", "cons_T_easy", "tsun_T_easy", "pana_T_easy", "kabu_T_easy", "gulf_F_easy", "oedi_T_easy", "vaud_T_easy", "mont_F_easy", "demo_F_easy" _ ) Dim hard14 As Variant hard14 = Array( _ "spee_F_hard", "dwar_F_hard", "carb_T_hard", "bohr_T_hard", "gang_F_hard", "vitc_F_hard", "hert_F_hard", "pucc_F_hard", "troy_T_hard", "moza_F_hard", "croc_F_hard", "gees_F_hard", "lute_F_hard", "memo_F_hard" _ ) Dim colsAll As Variant, colsEasy As Variant, colsHard As Variant colsAll = BuildPresentColArray(all28, ws) colsEasy = BuildPresentColArray(easy14, ws) colsHard = BuildPresentColArray(hard14, ws) Dim colBS28 As Long, colBSEasy As Long, colBSHard As Long colBS28 = EnsureOutputColumn(ws, "bs_28") colBSEasy = EnsureOutputColumn(ws, "bs_easy") colBSHard = EnsureOutputColumn(ws, "bs_hard") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Dim r As Long For r = 2 To lastRow ws.Cells(r, colBS28).Value = MeanOfRow(ws, r, colsAll) ws.Cells(r, colBSEasy).Value = MeanOfRow(ws, r, colsEasy) ws.Cells(r, colBSHard).Value = MeanOfRow(ws, r, colsHard) Next r End Sub