Using VBA to insert Columns

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

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" <[email protected]> wrote in message
news:[email protected]...
> 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

....also I guess the first 4 instructions of your code can be reduced to one:

Sheet1.Rows("11:5000").ClearContents

Regards,
KL

Why not just

Range("C:C").Insert Shift:=xlToLeft


And if he really means two coilumns, best to do it sepoarately, last first

Range("H:H").Insert Shift:=xlToLeft
Range("C:C").Insert Shift:=xlToLeft


--

HTH

RP
(remove nothere from the email address if mailing direct)


"KL" <[email protected]> wrote in message
news:%[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
> > 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
>
>

Hi Bob,

I think the OP really means 2 columns :-))
Anyway, the instruction Range("C:C,I:I").Insert Shift:=xlToLeft was aimed at
saving space, but I guess you are right: it is much "user-friendlier" to
insert columns/rows starting from the last one, e.g for multiple columns:

col=Array("C","I","M","Z")
for i=UBound(col) To LBound(col) Step -1
Range(col(i) & ":" & col(i)).Insert Shift:=xlToLeft
Next i

Regards,
KL


"Bob Phillips" <[email protected]> wrote in message
news:%[email protected]...
> Why not just
>
> Range("C:C").Insert Shift:=xlToLeft
>
>
> And if he really means two coilumns, best to do it sepoarately, last first
>
> Range("H:H").Insert Shift:=xlToLeft
> Range("C:C").Insert Shift:=xlToLeft
>
>
> --
>
> HTH
>
> RP
> (remove nothere from the email address if mailing direct)
>
>
> "KL" <[email protected]> wrote in message
> news:%[email protected]...
>> 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" <[email protected]> wrote in message
>> news:[email protected]...
>> > 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
>>
>>
>
>

Problem is KL, if you have many columns, trying to work out the correct
value for each <vbg>. Does my head in. KISS is a good maxim.

Bob


"KL" <[email protected]> wrote in message
news:[email protected]...
> Hi Bob,
>
> I think the OP really means 2 columns :-))
> Anyway, the instruction Range("C:C,I:I").Insert Shift:=xlToLeft was aimed
at
> saving space, but I guess you are right: it is much "user-friendlier" to
> insert columns/rows starting from the last one, e.g for multiple columns:
>
> col=Array("C","I","M","Z")
> for i=UBound(col) To LBound(col) Step -1
> Range(col(i) & ":" & col(i)).Insert Shift:=xlToLeft
> Next i
>
> Regards,
> KL
>
>
> "Bob Phillips" <[email protected]> wrote in message
> news:%[email protected]...
> > Why not just
> >
> > Range("C:C").Insert Shift:=xlToLeft
> >
> >
> > And if he really means two coilumns, best to do it sepoarately, last
first
> >
> > Range("H:H").Insert Shift:=xlToLeft
> > Range("C:C").Insert Shift:=xlToLeft
> >
> >
> > --
> >
> > HTH
> >
> > RP
> > (remove nothere from the email address if mailing direct)
> >
> >
> > "KL" <[email protected]> wrote in message
> > news:%[email protected]...
> >> 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" <[email protected]> wrote in message
> >> news:[email protected]...
> >> > 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
> >>
> >>
> >
> >
>
>

Yup. I do agree with that :-)

KL


"Bob Phillips" <[email protected]> wrote in message
news:ea%[email protected]...
> Problem is KL, if you have many columns, trying to work out the correct
> value for each <vbg>. Does my head in. KISS is a good maxim.
>
> Bob
>
>
> "KL" <[email protected]> wrote in message
> news:[email protected]...
>> Hi Bob,
>>
>> I think the OP really means 2 columns :-))
>> Anyway, the instruction Range("C:C,I:I").Insert Shift:=xlToLeft was aimed
> at
>> saving space, but I guess you are right: it is much "user-friendlier" to
>> insert columns/rows starting from the last one, e.g for multiple columns:
>>
>> col=Array("C","I","M","Z")
>> for i=UBound(col) To LBound(col) Step -1
>> Range(col(i) & ":" & col(i)).Insert Shift:=xlToLeft
>> Next i
>>
>> Regards,
>> KL
>>
>>
>> "Bob Phillips" <[email protected]> wrote in message
>> news:%[email protected]...
>> > Why not just
>> >
>> > Range("C:C").Insert Shift:=xlToLeft
>> >
>> >
>> > And if he really means two coilumns, best to do it sepoarately, last
> first
>> >
>> > Range("H:H").Insert Shift:=xlToLeft
>> > Range("C:C").Insert Shift:=xlToLeft
>> >
>> >
>> > --
>> >
>> > HTH
>> >
>> > RP
>> > (remove nothere from the email address if mailing direct)
>> >
>> >
>> > "KL" <[email protected]> wrote in message
>> > news:%[email protected]...
>> >> 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" <[email protected]> wrote in message
>> >> news:[email protected]...
>> >> > 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
>> >>
>> >>
>> >
>> >
>>
>>
>
>

Gentlemen
Thank you both for your input. Your suggestions have worked perfectly. As
you have probably worked out, it was not my code, but incomplete code done by
others.
I have tried every way known to man, to get VBA to stay in my head, but
while I have a pretty handy knowledge of Excel and contribute to this
newsgroup frequently, VBA eludes me.
Anyway, thanks again for your time and effort.

Regards
Michael
--
Michael Mitchelson


"KL" wrote:

> Yup. I do agree with that :-)
>
> KL
>
>
> "Bob Phillips" <[email protected]> wrote in message
> news:ea%[email protected]...
> > Problem is KL, if you have many columns, trying to work out the correct
> > value for each <vbg>. Does my head in. KISS is a good maxim.
> >
> > Bob
> >
> >
> > "KL" <[email protected]> wrote in message
> > news:[email protected]...
> >> Hi Bob,
> >>
> >> I think the OP really means 2 columns :-))
> >> Anyway, the instruction Range("C:C,I:I").Insert Shift:=xlToLeft was aimed
> > at
> >> saving space, but I guess you are right: it is much "user-friendlier" to
> >> insert columns/rows starting from the last one, e.g for multiple columns:
> >>
> >> col=Array("C","I","M","Z")
> >> for i=UBound(col) To LBound(col) Step -1
> >> Range(col(i) & ":" & col(i)).Insert Shift:=xlToLeft
> >> Next i
> >>
> >> Regards,
> >> KL
> >>
> >>
> >> "Bob Phillips" <[email protected]> wrote in message
> >> news:%[email protected]...
> >> > Why not just
> >> >
> >> > Range("C:C").Insert Shift:=xlToLeft
> >> >
> >> >
> >> > And if he really means two coilumns, best to do it sepoarately, last
> > first
> >> >
> >> > Range("H:H").Insert Shift:=xlToLeft
> >> > Range("C:C").Insert Shift:=xlToLeft
> >> >
> >> >
> >> > --
> >> >
> >> > HTH
> >> >
> >> > RP
> >> > (remove nothere from the email address if mailing direct)
> >> >
> >> >
> >> > "KL" <[email protected]> wrote in message
> >> > news:%[email protected]...
> >> >> 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" <[email protected]> wrote in message
> >> >> news:[email protected]...
> >> >> > 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
> >> >>
> >> >>
> >> >
> >> >
> >>
> >>
> >
> >
>
>
>

Hi Michael,

Didn't notice it was you. Although you signature carries your surname, you
NG handle doesn't. As I have said before, it is good to help a helper <G>

Regards

Bob


"Michael" <[email protected]> wrote in message
news:[email protected]...
> Gentlemen
> Thank you both for your input. Your suggestions have worked perfectly. As
> you have probably worked out, it was not my code, but incomplete code done
by
> others.
> I have tried every way known to man, to get VBA to stay in my head, but
> while I have a pretty handy knowledge of Excel and contribute to this
> newsgroup frequently, VBA eludes me.
> Anyway, thanks again for your time and effort.
>
> Regards
> Michael
> --
> Michael Mitchelson
>
>
> "KL" wrote:
>
> > Yup. I do agree with that :-)
> >
> > KL
> >
> >
> > "Bob Phillips" <[email protected]> wrote in message
> > news:ea%[email protected]...
> > > Problem is KL, if you have many columns, trying to work out the
correct
> > > value for each <vbg>. Does my head in. KISS is a good maxim.
> > >
> > > Bob
> > >
> > >
> > > "KL" <[email protected]> wrote in message
> > > news:[email protected]...
> > >> Hi Bob,
> > >>
> > >> I think the OP really means 2 columns :-))
> > >> Anyway, the instruction Range("C:C,I:I").Insert Shift:=xlToLeft was
aimed
> > > at
> > >> saving space, but I guess you are right: it is much "user-friendlier"
to
> > >> insert columns/rows starting from the last one, e.g for multiple
columns:
> > >>
> > >> col=Array("C","I","M","Z")
> > >> for i=UBound(col) To LBound(col) Step -1
> > >> Range(col(i) & ":" & col(i)).Insert Shift:=xlToLeft
> > >> Next i
> > >>
> > >> Regards,
> > >> KL
> > >>
> > >>
> > >> "Bob Phillips" <[email protected]> wrote in message
> > >> news:%[email protected]...
> > >> > Why not just
> > >> >
> > >> > Range("C:C").Insert Shift:=xlToLeft
> > >> >
> > >> >
> > >> > And if he really means two coilumns, best to do it sepoarately,
last
> > > first
> > >> >
> > >> > Range("H:H").Insert Shift:=xlToLeft
> > >> > Range("C:C").Insert Shift:=xlToLeft
> > >> >
> > >> >
> > >> > --
> > >> >
> > >> > HTH
> > >> >
> > >> > RP
> > >> > (remove nothere from the email address if mailing direct)
> > >> >
> > >> >
> > >> > "KL" <[email protected]> wrote in message
> > >> > news:%[email protected]...
> > >> >> 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" <[email protected]> wrote in message
> > >> >> news:[email protected]...
> > >> >> > 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
> > >> >>
> > >> >>
> > >> >
> > >> >
> > >>
> > >>
> > >
> > >
> >
> >
> >