Dear offthelip
First of all >> Many many thanks for your time and efforts !!
I noticed that you made 3 Arrays. Very nice indeed !
I start working on your code and after firuring out what you done, I correct some minor mistakes (especially typing mistake, upper case etc'....)
I came to this line of code and got an Error:
If CCarray(i, 1).Value = Sheet2array(Z, 1).Value And _
CCarray(i, 2).Value = Sheet2array(Z, 2).Value Then
Attachment 17956
I'm placing here the code after corrected the minor mistakes:
Sub ColorCellsConditions()
'change the cursor to hourglass
Application.Cursor = xlWait
'Use the Status Bar to inform user of the macro's progress
'Makes sure that the statusbar is visible
Application.DisplayStatusBar = True
'add your message to status bar
Application.StatusBar = "wait...under pross...."
'
Application.Calculation = xlCalculationManual
'
'Remember time when macro starts
StartTime = Timer
Application.ScreenUpdating = False
LR = Worksheets("Condition and columns to Mark").Cells(Rows.Count, "A").End(xlUp).row
cclastrow = Worksheets("Condition Check").Cells(Rows.Count, "A").End(xlUp).row
'Set an Array
Worksheets("Condition and columns to Mark").Activate
Sheet2array = Worksheets("Condition and columns to Mark").Range(Cells(1, 1), Cells(cclastrow, 13))
'Set an Array
Worksheets("Condition Check").Activate
CCarray = Worksheets("Condition Check").Range(Cells(1, 1), Cells(LR, 2))
'Set an Array
Worksheets("Condition and columns to Mark").Activate
Sheet2output = Worksheets("Condition and columns to Mark").Range(Cells(1, 3), Cells(cclastrow, 500))
LastRow = Sheets("Sub Totals").Cells(Rows.Count, "A").End(xlUp).row
Worksheets("Sub Totals").Activate
For Z = 2 To LR
'Loop to define cell address when criteria is match
For i = 2 To cclastrow
If CCarray(i, 1).Value = Sheet2array(Z, 1).Value And _
CCarray(i, 2).Value = Sheet2array(Z, 2).Value Then
For j = 3 To 11
collet = Sheet2array(Z, j)
If collet = "" Then Exit For
' convert this letter to a number so that we can use it for addressing!! Any chance of specifying the columns by number?
Columnno = 0
For kk = 1 To Len(collet)
Columnno = Columnno * 26 + (Asc(UCase(Mid(collet, kk, 1))) - 64)
Next kk
If LastRow = 1048576 Then GoTo sheetEnd
LastRow = LastRow + 1
' CCarray(i, Columnno) = CriteriaCheck.Range(x & i).Address
Sheet2output(LastRow, 1) = CCarray(i, columno)
Next j
End If
Next i
Next Z
Worksheets("Condition and columns to Mark").Range(Cells(1, 3), Cells(cclastrow, 500)) = Sheet2output
sheetEnd:
Call SortAnd
Application.ScreenUpdating = True
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)
'restore default cursor
Application.Cursor = xlDefault
' gives control of the statusbar back to the programme
Application.StatusBar = False
'Notify user in seconds
MsgBox "The code has finished and Run for: " & SecondsElapsed & " Seconds " _
& vbNewLine & vbOKOnly + vbInformation, "Mark conditions"
Application.Calculation = xlCalculationAutomatic
End Sub