VBA Code to Display Data by not using Vlookup

[matt9man]

Ok here is my problem I have vba code that first displays first row of expected results then on the next row the code does a vlookup using the key in the expected to find the actual results. Problem is the vlookup is being used for every column which takes to long. Ideally I want it to vlookup just my key then all cells to right to be populated by some column reference. In my code below i commented out and colored in red what I am picturing in my head. Also keep in mind the keys may have ../// in it. Thanks

Sub PopulateExp()
Dim intExpRow As Long
Dim intCompRow As Long
Dim intCol As Long
intExpRow = 3
intCompRow = 3
intCol = 1
Sheet3.Select
intRowCnt = Sheet4.Cells(1, 2)
Call ClearAllComp
While Sheet2.Cells(intExpRow, intCol) <> ""
   Sheet3.Cells(intCompRow, intCol) = "Expected"
   Sheet3.Cells(intCompRow, intCol + 1) = Sheet2.Cells(intExpRow, intCol + 1)
   Sheet3.Cells(intCompRow, intCol + 2) = Sheet2.Cells(intExpRow, intCol + 2)
   Sheet3.Cells(intCompRow, intCol + 3) = Sheet2.Cells(intExpRow, intCol)
 
   While (intCol <= intRowCnt)
   Sheet3.Cells(intCompRow, intCol + 4) = Sheet2.Cells(intExpRow, intCol + 3).Value
   intCol = intCol + 1
   Wend
 
   Sheet3.Rows(intCompRow).Select
 
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
 
   Call PopulateAct(intCompRow)
 
   intCompRow = intCompRow + 2
   intExpRow = intExpRow + 1
 
 
intCol = 1
Wend
 
End Sub
Sub PopulateAct(intCompRow As Long)
Dim intExpRow As Long
Dim intCol As Long
intExpRow = 3
intCol = 1
intRowCnt = Sheet4.Cells(1, 2)
Sheet3.Select
   Sheet3.Cells(intCompRow + 1, intCol) = "Actual"
   Sheet3.Cells(intCompRow + 1, intCol + 1) = Sheet3.Cells(intCompRow, intCol + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 2) = Sheet3.Cells(intCompRow, intCol + 2)
 
   Sheet3.Cells(intCompRow + 1, intCol + 3) = "=VLOOKUP(D" & intCompRow & ",Actual!A1:ZZ100000," & (intCol) & ",FALSE)"
    If IsError(Sheet3.Cells(intCompRow + 1, intCol + 3).Value) Then
      Sheet3.Cells(intCompRow + 1, intCol + 3) = "Actual Result Not Found"
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
      Else
        actualRow = "=row(VLOOKUP(D" & intCompRow & ",Actual!A1:ZZ100000," & (intCol) & ",FALSE))"
[COLOR=red]       'loop through columns[/COLOR]
[COLOR=red]       '   populate[/COLOR]
[COLOR=red]       '       looking to actual row with column indexes[/COLOR]
[COLOR=red]       '   if equal[/COLOR]
[COLOR=red]       '       do nothing[/COLOR]
[COLOR=red]       '   else[/COLOR]
[COLOR=red]       '       format difference[/COLOR]
[COLOR=red]       'end while[/COLOR]
        
        If Sheet3.Cells(intCompRow + 1, intCol + 3).Value = Sheet3.Cells(intCompRow, intCol + 3).Value Then
           While (intCol <= intRowCnt)
            Sheet3.Cells(intCompRow + 1, intCol + 4) = Sheet5.Cells(intExpRow, intCol + 1).Value
            intCol = intCol + 1 'to exit loop
           Wend
 
        Else
            While (intCol <= intRowCnt)
                Sheet3.Cells(intCompRow + 1, intCol + 3).Interior.ColorIndex = 40
                Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
                Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
                Sheet3.Cells(intCompRow + 1, 2).Value = "Difference"
                Sheet3.Cells(intCompRow, 2).Value = "Difference"
            Wend
        End If
   End If
   intCol = intCol + 1
 
End Sub

 

[mole999]

you could turn off screen updating, calculation and events until its run, its probable from what i have read before that each formula is then calculated, hence taking too long

 

[matt9man]

Yea I have tried that before but still takes to long and also I get a overflow error (even when its set as Long) at 10,000. Thats why I want to populate by column indexes. Any ideas?