Using VBA to insert Columns

G

Guest

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
 
K

KL

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 said:
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
Click to expand...
 
K

KL

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

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

Regards,
KL
 
B

Bob Phillips

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 said:
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 said:
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
Click to expand...
Click to expand...
 
K

KL

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 said:
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 said:
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 said:
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
Click to expand...
Click to expand...
Click to expand...
 
B

Bob Phillips

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 said:
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 said:
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 said:
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



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
Click to expand...
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],
Click to expand...
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],
Click to expand...
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
Click to expand...
Click to expand...
Click to expand...
 
K

KL

Yup. I do agree with that :)

KL


Bob Phillips said:
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 said:
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 said:
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)


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



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
Click to expand...
Click to expand...
Click to expand...
 
G

Guest

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 said:
Yup. I do agree with that :)

KL


Bob Phillips said:
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 said:
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


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)


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



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
Click to expand...
Click to expand...
Click to expand...
 
B

Bob Phillips

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 said:
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 said:
Yup. I do agree with that :)

KL


Bob Phillips said:
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


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


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)


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



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
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Code: Bank Account Balance Macro 1
Importing a multi-sheet Excel spreadsheet into Access 9
backing up the code mods 1
Excel hangs 1
Excel hangs. Why? 1
Importing from Excel using INSERT INTO 2
Insert columns and values programmatically with IF statement 9
Adding a new column with VBA 1

Top