I have the following loops. Is there some alternative to these or a better way to combine them into the same statement? I have looked as Do While Loops but I don't really know if that is what I need.

I would like to make this a bit cleaner and more efficient if there are any suggestions.

dim i as integer
dim relay,money,house as worksheet
dim counter as long

For i = 3 To COUNTER
    If relay.Range(Cells(i, 4), Cells(i, 4)) = "SUMMARY" Then
    relay.Range(Cells(i, 5), Cells(i, 5)) = "SUMMARY " & relay.Range(Cells(i, 5), Cells(i, 5)).Offset(1, -2)
    Else
    relay.Range(Cells(i, 5), Cells(i, 5)) = WorksheetFunction.IfError(WorksheetFunction.Index(money.Range("a3:bz5000"), WorksheetFunction.Match(relay.Range(Cells(i, 4), Cells(i, 4)), money.Range("a3:a5000"), 0), 11), 0)
    relay.Range(Cells(i, 7), Cells(i, 7)) = WorksheetFunction.IfError(WorksheetFunction.Index(house.Range("a3:bz5000"), WorksheetFunction.Match(relay.Range(Cells(i, 4), Cells(i, 4)), house.Range("a3:a5000"), 0), 10), 0) / 100
    relay.Range(Cells(i, 8), Cells(i, 8)) = WorksheetFunction.IfError(WorksheetFunction.Index(house.Range("a3:bz5000"), WorksheetFunction.Match(relay.Range(Cells(i, 4), Cells(i, 4)), house.Range("a3:a5000"), 0), 9), 0) / 100
    relay.Range(Cells(i, 9), Cells(i, 9)) = WorksheetFunction.IfError(WorksheetFunction.Index(house.Range("a3:bz5000"), WorksheetFunction.Match(relay.Range(Cells(i, 4), Cells(i, 4)), house.Range("a3:a5000"), 0), 11), 0) / 100
End If
Next i

dim a,b,c,d as integer
dim counter,counto as long
dim relay,house,money as worksheet

For a = 3 To COUNTER
For b = 10 To COUNTO
    If relay.Range(Cells(a, 4), Cells(a, 4)) <> "SUMMARY" Then
    relay.Range(Cells(a, b), Cells(a, b)) = WorksheetFunction.Index(money.Range("a1:bz5000"), WorksheetFunction.Match(relay.Range(Cells(a, 4), Cells(a, 4)), money.Range("a:A"), 0), WorksheetFunction.Match(relay.Range(Cells(2, b), Cells(2, b)), money.Range("1:1"), 0))
    Else
    relay.Range(Cells(a, b), Cells(a, b)) = ""
    End If

Next b
Next a

For C = 3 To COUNTER
For D = 10 To COUNTO
If relay.Range(Cells(C, 4), Cells(C, 4)) = "SUMMARY" Then
relay.Range(Cells(C, D), Cells(C, D)) = WorksheetFunction.SumIf(relay.Range(Cells(3, 3), Cells(COUNTER, 3)), relay.Range(Cells(C, 3), Cells(C, 3)).Offset(1, 0), relay.Range(Cells(3, D), Cells(COUNTER, D)))
Else
relay.Range(Cells(C, D), Cells(C, D)) = relay.Range(Cells(C, D), Cells(C, D))
End If
Next D
Next C