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