| Home |
| Search |
| Today's Posts |
|
#1
|
|||
|
|||
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 |
|
#2
|
|||
|
|||
|
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 |
|
#3
|
|||
|
|||
|
....also I guess the first 4 instructions of your code can be reduced to one:
Sheet1.Rows("11:5000").ClearContents Regards, KL |
|
#4
|
|||
|
|||
|
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" wrote in message ... 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 |
|
#5
|
|||
|
|||
|
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" wrote in message ... 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" wrote in message ... 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 |
|
#6
|
|||
|
|||
|
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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 |
|
#7
|
|||
|
|||
|
Yup. I do agree with that :-)
KL "Bob Phillips" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 |
|
#8
|
|||
|
|||
|
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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 |
|
#9
|
|||
|
|||
|
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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| How do I insert multiple columns? | Excel Discussion (Misc queries) | |||
| can't insert columns between columns | Excel Discussion (Misc queries) | |||
| When sorting info in columns, can I make it insert blank line bet. | Excel Worksheet Functions | |||
| Challenging Charting | Charts and Charting in Excel | |||
| How do I take two columns of sequential numbers and insert spaces | Excel Discussion (Misc queries) | |||
Linear Mode
