Listed below is the entire macro - look for the text

'This is the part I'm interested in (this text is at the beginning and
ending of the part of the macro I'm looking to improve.)

what I'm doing is taking up to a maximum of 20 numbers and putting them into
2 columns with a max of 10 each. Based on if the "Plan" "issue age" and
"Duration" match

Sub refresh_tables()
Dim rQueryInfo As Range, strDBPath As String, strDB As String
Dim strConnection As String, strCommandText As String, irow As Long
Dim strTab As String, strName As String, strQuery As String
Dim strCurrDB As String, strPrevDB As String
Dim strCurrDBPath As String, strPrevDBPath As String
Dim strCurrPrev As String
Dim wbA As Workbook
Dim oldStatusBar, t1 As Date
Dim strTable As String
Dim j As Long

Dim cv1 As Long
Dim cv2 As Long

Dim cvkey1 As String
Dim cvkey2 As String

Dim key1 As Range
Dim key2 As Range
Dim key3 As Range
Dim key4 As Range
Dim key5 As Range
Dim key6 As Range
Dim key7 As Range
Dim key8 As Range
Dim key9 As Range

Set key1 = shtInput.Range("c24:c33")
Set key2 = shtInput.Range("g24:g33")
Set key3 = shtInput.Range("h24:h33")
Set key4 = shtInput.Range("i24:i33")
Set key5 = shtInput.Range("k24:k33")

Set key6 = shtCV.Range("B4:B24")
Set key7 = shtCV.Range("C4:C24")
Set key8 = shtCV.Range("D4:D24")
Set key9 = shtCV.Range("E4:E24")

t1 = Now()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True

Set wbA = ActiveWorkbook
' strTab = "Sheet1"
' strRange = "A3"
' strDB = "Cash_Values"
' strDBPath = "V:\lif\lifediv\critical control\bradinfo\"
' strQuery = "GetCashValue"


' strCurrDBPath = Range("CurrDB").Value
' If Right(strCurrDBPath, 1) = "\" Then strCurrDBPath = Left(strCurrDBPath,
Len(strCurrDBPath) - 1)
' strCurrDB = Range("CurrDB").Offset(0, 1).Value
irow = 1
strTab = "sheet1"
strName = "Cash_Value_1"
strDB = "Cash_Values"
strDBPath = "V:\lif\lifediv\critical control\bradinfo"
' strTable = "GetCashValue" '"CashValu"
strTable = "CashValu"

' strQuery = " " ' " Where plan='10001' and Age=35 and (Duration=10 or
Duration=11); "
strQuery = " Where "
strQuery = strQuery & "(plan=" & "'" & key1(irow) & "'" & " and Age="
& key2(irow) & " and (Duration=" & key3(irow) & " or Duration=" & key3(irow)
+ 1 & ")) "

For irow = 2 To 10
If key1(irow) < "" Then
strQuery = strQuery & " OR(plan=" & "'" & key1(irow) & "'" & "
and Age=" & key2(irow) & " and (Duration=" & key3(irow) & " or Duration=" &
key3(irow) + 1 & ")) "
' MsgBox (strQuery)
' strQuery = strQuery & "OR (plan='10001' and Age=45 and
(Duration=10 or Duration=11)) "
End If
Next
strConnection = "ODBC;DSN=MS Access Database;DBQ=" & strDBPath & "\" &
strDB & ".mdb;DefaultDir=" & strDBPath & ";DriverId=25;FIL=MS
Access;MaxBufferSize=2048;PageTimeout=5;"
strCommandText = "SELECT * FROM `" & strDBPath & "\" & strDB & "`." &
strTable & strQuery
'Debug.Print strTab; "<"; strName; "<"; strQuery
' Debug.Print strConnection
' Debug.Print strCommandText
With wbA.Worksheets(strTab).QueryTables(strName)
Application.ScreenUpdating = True
Application.StatusBar = "updating cash value table "
' Application.StatusBar = "updating [" & strTab & "]" & strQuery
Application.ScreenUpdating = False
.Connection = strConnection
.CommandText = strCommandText
.Refresh BackgroundQuery:=False
End With


'This is the part I'm interested in

key4.ClearContents
key5.ClearContents

irow = 1
For irow = 1 To shtInput.Range("a37").Value
If key2(irow) < "" Then
cvkey1 = key1(irow) & key2(irow) & key3(irow)
cvkey2 = key1(irow) & key2(irow) & key3(irow) + 1
End If
For j = 1 To (shtInput.Range("a37").Value * 2)
If cvkey1 = key6(j) & key7(j) & key8(j) Then
key4(irow) = key9(j)
End If
If cvkey2 = key6(j) & key7(j) & key8(j) Then
key5(irow) = key9(j)
End If
Next j
Next irow

'This is the part I'm interested in


Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
Application.ScreenUpdating = True
Application.Calculate
Application.Calculation = xlCalculationAutomatic
' MsgBox Format(Now() - t1, "hh:nn:ss")
End Sub