Hi Michael,

You aren't forgetting that each time you insert a column the data on the
right side of it move further to the right, are you? Also to remind you that
it is not necessary to select objects to perform most of the operations on
them.

Try these instructions at the end of your code (after Wend line)

Range("C:C,I:I").Insert Shift:=xlToLeft
Range("C10,J10") = "Receiver CC"

Regards,
KL



"Michael" wrote in message
...
Hi All
I use the code below to import data from a database.
However, once the data is in place I need to add a new column after column
B
, and another column after columns H.
I have tried a number of times myself, but every time I attempt to run the
new Macro it puts the columns in the wrong places.
Any help would be appreciated.

Public Sub DoIt()

Sheet1.Activate
Sheet1.Rows("11:5000").Select
Selection.ClearContents
Sheet1.Range("A5").Select

Dim strSQL As String
Dim recSet As DAO.Recordset
Dim intRow As Integer
Dim strFilter As String

If Sheet1.Range("B5") < "" And Sheet1.Range("B6") < "" Then
strFilter = "WHERE [Accomplishment Date] = #" &
Sheet1.Range("B5").Text & "# AND [Accomplishment Date] <= #" &
Sheet1.Range("B6").Text & "#"
End If


strSQL = "SELECT Accomplishment.[Cost Centre] as [Cost Centre
Number], Accomplishment.[Shift Code] as [Rate Code], Accomplishment.WBS as
[WBS Element], Sum([Work Team Size]*[Time Worked]) AS [Total Hours] "
strSQL = strSQL & "FROM Accomplishment "
strSQL = strSQL & " " & strFilter
strSQL = strSQL & "GROUP BY Accomplishment.WBS,
Accomplishment.[Cost
Centre], Accomplishment.[Shift Code]"

Set recSet = GetDBValue(strSQL)

' Dim col As Field
' For Each col In recSet.Fields
' Sheet1.Range(Chr(col.OrdinalPosition + 65) & 10) = col.Name
' Next

intRow = 11
While Not recSet.EOF
For Each col In recSet.Fields
Sheet1.Range(Chr(col.OrdinalPosition + 65) & intRow) =
recSet(col.Name) & ""
Next


recSet.MoveNext
intRow = intRow + 1
Wend

strSQL = "SELECT Accomplishment.[Cost Centre] as [Cost Centre
Number], Accomplishment.[Shift Code] as [Rate Code], Accomplishment.WBS as
[WBS Element], Sum([Work Team Size B]*[Time Worked]) AS [Total Hours] "
strSQL = strSQL & "FROM Accomplishment "
strSQL = strSQL & " " & strFilter
strSQL = strSQL & "GROUP BY Accomplishment.WBS,
Accomplishment.[Cost
Centre], Accomplishment.[Shift Code]"

Set recSet = GetDBValue(strSQL)

' For Each col In recSet.Fields
' Sheet1.Range(Chr(col.OrdinalPosition + 71) & 10) = col.Name
' Next

intRow = 11
While Not recSet.EOF
For Each col In recSet.Fields
Sheet1.Range(Chr(col.OrdinalPosition + 71) & intRow) =
recSet(col.Name) & ""
Next


recSet.MoveNext
intRow = intRow + 1
Wend
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("C10").Select
ActiveCell.FormulaR1C1 = "Receiver CC"
Range("J10").Select
ActiveCell.FormulaR1C1 = "Receiver CC"

End Sub

Regards
Michael

--
Michael Mitchelson