Hmmm something is not working the way it should. I get a subscript out of range. I'm trying to create my macro in a way that would work in a fresh file where the macro would do all the work. Here is the code. It goes out of range at the for loop:
Sub CrossingTest()
Sheets.Add
Sheets("Sheet4"

.Select
Sheets("Sheet4"

.Name = "Query"
Sheets("Sheet1"

.Select
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=landmarkprod;UID=landmarkdata;APP=Microsoft Office XP;DATABASE=Landmark;Trusted_Connection=Yes" _
, Destination:=Range("A1"

)
.CommandText = Array( _
"SELECT account.short_name" & Chr(13) & "" & Chr(10) & "FROM Landmark.dbo.account account" & Chr(13) & "" & Chr(10) & "WHERE (account.short_name Like '+''+''$D1''+''%')" _
)
.Name = "Query from landmarkprod_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
Dim MyColumnD_Range As Range
Set MyColumnD_Range = Range(Cells(1, "D"

, Cells(1, "D"

.End(xlDown))
For Each c In MyColumnD_Range
With Sheets("Query"

.QueryTables(1) ---OUT OF RANGE!
.Connection = _
"ODBC;DSN=landmarkprod;UID=landmarkdata;APP=Microsoft Office XP;DATABASE=Landmark;Trusted_Connection=Yes"
.CommandText = _
"SELECT account.short_name " & _
"FROM Landmark.dbo.account account " & _
"WHERE (account.short_name Like '" & c.Value & "%')"
.Refresh BackgroundQuery:=False
With .Cells(1, 1)
RowCount = .CurrentRegion.Rows.Count
If RowCount = 2 Then
c.Value = .Offset(1, 0).Value
Else
'End Sub
End If
End With
End With
Next
End Sub