How to speed up writing to cells with VBA??

Dear experts,

I am desperately looking for your help. I have a code (below simplified) with around 20 "checks" that need to be done per each line found in the excel worksheet. The problem is that each ''check'' can have different results, therefore I am doubting whether an array would work. I believe the code is slow due to interaction with the worksheet (writing back each cell separately).

Below is a very simplified portion of what I try to do. In reality I loop over 100k rows with 20 criteria to be written in different columns.

Is there any way to speed this up?

Thank you very much for you kind help!

Bundi

Sub Problem()

Dim wsProblem As Worksheet
Dim i As Long
Dim element As String
Dim Arr() As Variant

i = 5

With ws.Problem
'Start Loop
Do While Not (IsEmpty(.Cells(i, 1)))

    ReDim Arr(1 To 2)

    element = .Cells(i, 5)

    'Criteria 1
    If IsNumeric(Mid(element, 4, 1)) Then

        Arr(1) = 3

    End If

    'Criteria 2
    If Len(element) <> 8 And Mid(element, 3, 1) = 8 Then

        Arr(2) = 7

    Else

        Arr(2) = 9

    End If

    i = i + 1
    
    'Write values
    Range(.Cells(i, 12), .Cells(i, 12)).Resize(LBound(Arr, 1), UBound(Arr, 1)).Value = Arr

Loop

End Sub
'End Sub

How is the data initially been written to the sheet ????
See big yellow banner, workbook would be more useful.

Thanks torachan, you are right. I have enclosed a very basic function of what I need. Due to very limited cells it seems to run fast, but in reality with more conditions and rows it takes long. If in my real macro I disable all the writing to cells, it runs fast indicating the issue is there.

Thanks in advance for your time!

Had a quick look and seeded with upto 500,000 rows and run timer, it was 20% quicker just using a simple loop instead of arrays.
This is the sort of sorting that @Jindon would apply a 'speed of light' solution to if he has read your posting.
The attached is how I quickly looked at it, clear column 'C' and seed 'A' with 10,000 or 50,000 or 100,000 or 500,000 rows.
Your procedure is still on its original button, my simple loop is on button 'LOOP THRU' both are on a simple timer.

In reality I loop over 100k rows with 20 criteria to be written in different columns.

It will take time...
For the file you uploaded.

Sub test()
    Dim a, b, i As Long
    With Range("a2", Range("a" & Rows.Count).End(xlUp))
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To 2)
        For i = 1 To UBound(a, 1)
            If (Len(a(i, 1)) = 8) * (Left$(a(i, 1), 1) = "B") Then
                b(i, 2) = "Dummy"
            Else
                b(i, 2) = "Check" & Left$(a(i, 1), 2)
            End If
            If a(i, 1) Like "?????#*" Then b(i, 1) = 3
        Next
        .Offset(, 1).Resize(, 2).Value = b
    End With
End Sub