Excel Macro results differ when stepping through code

[Jean9]

When I step through the code below, the results on the worksheet are as they should be (the total label is in J whatever and the total is in K whatever) but when I run through the macro without any code breaks, the worksheet header rows (in this case range A1:K7) are shifted over to range C1:M7, the total label that should be in J whatever is in L9, and the total that the macro should be placing at the end of K whatever is in M9. What is missing from the code to prevent this?
<code>
Private Sub TotalDist(sWS As String)

' Put a total in the last row of the worksheet
Dim lStart As Long
Sheets(sWS).Select
With Worksheets(sWS)
lStart = GetLastRow(sWS)
.Range("K8:E" & lStart).Select
lStart = lStart + 1
.Range("K" & lStart).Activate
ActiveCell.Formula = "=SUM(K8:K" & lStart - 1 & ")"
Range("K" & lStart).Select
Selection.Style = "Comma"
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("J" & lStart).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Total"
Range("J" & lStart).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Reset Focus
.Range("A8").Select
End With

End Sub
</code>

Thanks in advance for any help.

 

[SkipVought]

hi,

FYI: VBA (macros) are best addressed in forum707.

Using Select & Activate in code, like you are doing, is not a very good practice. You can experience some strange results on occasion. Rather, index a row pointer and use the range property or Cells property of the sheet object.

But my question, why code a formula that could just as well be done on the sheet? If you have 2007+, entering a proper formula in one cell, automatically propagates the formula to ALL rows AND added rows will contain your formula Automatically! This can also include other formatting. This new feature is called Structured Tables in 2007+.

Maybe I'm missing something, but you seem to have complicated something simple.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Jean9]

Thanks for pointing me to the right forum and your reply anyhow. Would you by chance have a code sample of indexing a row pointer and using the range property or cells property? I'm pretty much a novice at vba for excel. That was all code to add a Total label and value at the end of whatever gets dumped onto some worksheets from other executed vba code. There's probably much more elegant code to do that. I'm just not familiar with it.

The users only have Excel 2003. They are unsure when they will be moving to a newer version.

 

[xlbo]

basically - whenever you have .activate at the end of a line and activecell. at the start of the next line you can remove the activate and activecell so:

.Range("K" & lStart).Activate 
ActiveCell.Formula = "=SUM(K8:K" & lStart - 1 & ")"

becomes

.Range("K" & lStart).Formula = "=SUM(K8:K" & lStart - 1 & ")"

Also, if you have .select at the end of a line and selection. at the start of the next you can do the same e.g.

Range("K" & lStart).Select 
Selection.Style = "Comma"

becomes:

Range("K" & lStart).Style = "Comma"

If you are going to perform multiple operations on teh same range then

Range("K" & lStart).Select 
Selection.Style = "Comma" 
Selection.Font.Bold = True 
Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
Selection.Borders(xlEdgeLeft).LineStyle = xlNone 
With Selection.Borders(xlEdgeTop) 
.LineStyle = xlContinuous 
.ColorIndex = 0 
.TintAndShade = 0 
.Weight = xlThin 
End With 
With Selection.Borders(xlEdgeBottom) 
.LineStyle = xlDouble 
.ColorIndex = 0 
.TintAndShade = 0 
.Weight = xlThick 
End With 
Selection.Borders(xlEdgeRight).LineStyle = xlNone 
Selection.Borders(xlInsideVertical).LineStyle = xlNone 
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

can become

With Range("K" & lStart)
.Style = "Comma" 
.Font.Bold = True 
.Borders(xlDiagonalDown).LineStyle = xlNone 
.Borders(xlDiagonalUp).LineStyle = xlNone 
.Borders(xlEdgeLeft).LineStyle = xlNone 
With .Borders(xlEdgeTop) 
.LineStyle = xlContinuous 
.ColorIndex = 0 
.TintAndShade = 0 
.Weight = xlThin 
End With 
With .Borders(xlEdgeBottom) 
.LineStyle = xlDouble 
.ColorIndex = 0 
.TintAndShade = 0 
.Weight = xlThick 
End With 
.Borders(xlEdgeRight).LineStyle = xlNone 
.Borders(xlInsideVertical).LineStyle = xlNone 
.Borders(xlInsideHorizontal).LineStyle = xlNone 
end with

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[Jean9]

Thanks, Geoff and Skip...here's what I changed the code to. Not that it changed my results any...when I put a break in the code and step through, this code works perfectly. When I run the macro without any breaks, the top 8 columns of the worksheets are shifted to the right by two, leaving the details columns in place and then the Total label and amount are being placed in L9 and M9 respectively. Anything else you can think of that might make this work?

Private Sub TotalDist(sWS As String)

    ' Put a total in the last row of the worksheet
    Dim lStart As Long
    Sheets(sWS).Select
    With Worksheets(sWS)
        lStart = GetLastRow(sWS)
        lStart = lStart + 1
        .Range("K" & lStart).Formula = "=SUM(K8:K" & lStart - 1 & ")"
        With Range("K" & lStart)
            .Style = "Comma"
            .Font.Bold = True
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlDouble
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThick
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        .Range("J" & lStart).FormulaR1C1 = "Total"
        With Range("J" & lStart)
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
            .Font.Bold = True
        End With
         ' Reset Focus
        .Range("A8").Select
    End With
    
End Sub

 

[SkipVought]

' Put a total in the last row of the worksheet

WHY?

Why would you impose this 19[sup]th[/sup] & 20[sup]th[/sup] century accounting practice on your poor users???

This practice is a vestage of paper, pencil & adding machine accounting!!!

Each leger sheet has a SUBTOTAL at the BOTTOM, and the last sheet has the Grand Total: The BOTTOM LINE!!!

This paradigm began changing with electronic spreadsheets, where aggregations could be placed ANYWHERE on a sheet.

So WHY bury the summaries waaaaaaaayyyyyy down at the bottom???

Why not right at the TOP. Why not, in the spriri of Bob Uecker, "in the FRONT ROW!"

Why waste all this time and effort to make the summary a "find it if you can" entity?

Put the formula AT THE TOP or on a summary sheet: no messy code required!

BYW, the only instance I have encountered, where data SHIFTS, as you have described, is related to data above QueryTables. Other than that, I have never encountered in nearly 20 years of working with Excel.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Jean9]

Ummmmm....shrug...that's what THEY want, not me...I'd prefer not to look for the total either. But, that being said, I will say that the data on these tabs is coming from a Query Table soooooo are you saying that I should maybe not try to put the total at the end of the query table? or there's a BETTER way to put a total (in MS Excel 2003) at the end of the query table (each worksheet has a different query table connected with it, until the connections are deleted at the beginning of the next run of the macro...my way of making sure that if more than one user runs it from more than one machine, there's not a gazillion unused connections from the last time it was run)?

 

[SkipVought]

Totals at the end of a table almost always are the cause of some issue that requires handstands, cartwheels & backflips to rectify.

until the connections are deleted at the beginning of the next run of the macro

What's THAT all about?

How do you go about accomplishing THAT?

THAT may be a significant part of your problem.

Connections should not be deleted; rather MODIFIED.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Jean9]

The subroutine order is like delete any connections from previous runs, clear worksheets ranges A8 through K(last row), create query tables, and then run the totaling sub. The code below is what is used to delete the connections. My thought was that the query defs are stored on the user's machine and if the macro is run from another machine, there might not be any query defs/connections to modify so better to just delete what might be there and start fresh at each run.

Private Sub RemoveQueries()
On Error GoTo Error_RemoveQueries
    
    ' No connections should remain from one macro run to the next just in case
    ' the macro is run from more than one machine.  Delete all the connections.
    Dim ws As Worksheet
    Dim qt As QueryTable
    Dim i As Integer
    For Each ws In ThisWorkbook.Worksheets
        For Each qt In ws.QueryTables
            qt.Delete
        Next qt
    Next ws
    
    'Delete the Data Connections to alleviate warning message.
    If ActiveWorkbook.Connections.Count > 0 Then
        For i = 1 To ActiveWorkbook.Connections.Count
            ActiveWorkbook.Connections.Item(1).Delete
        Next i
'    Else
'        MsgBox ActiveWorkbook.Connections.Count
    End If
    
Exit_RemoveQueries:
    Exit Sub
    
Error_RemoveQueries:
    sMSG = "Error in RemoveQueries: " & Err.Number & " " & Err.Description
    sTITLE = "Error"
    MsgBox sMSG, vbCritical, sTITLE
    Resume Exit_RemoveQueries
    
End Sub

 

[SkipVought]

OUCH!

When you ADD a new QT, this is where you get the shifting of data!!!

So how do you ADD new QT? Show me THAT code.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Jean9]

Below is the code used to add the Query Table...there might be some unused references and a couple of mis-placed comments...it's not been cleaned up completely..

Private Sub SelectDATA(sSQL As String, sWS As String)
On Error GoTo Error_SelectDATA

    ' Create a connection for each iteration through this sub.
    ' The connections will be deleted at wrap up.
    Dim sCONN As String, oQT As QueryTable, rTMP As Range
    
    ' Set up the connection string
    sCONN = "ODBC;DSN=Excel Files;"
    sCONN = sCONN & "DBQ=" & ActiveWorkbook.FullName & ";"
    sCONN = sCONN & "DefaultDir=" & ActiveWorkbook.Path & ";"
    sCONN = sCONN & "DriverId=790;MaxBufferSize=8000;PageTimeout=5;"
    
    'create the QueryTable object
    Sheets(sWS).Select
    Set oQT = ActiveWorkbook.ActiveSheet.QueryTables.Add( _
    Connection:=sCONN, _
    Destination:=Range("A8"), _
    Sql:=sSQL)
    With oQT
        .FieldNames = False
        .BackgroundQuery = True
        .AdjustColumnWidth = False
        .Name = sWS
        'run the query
        .Refresh
    End With
    
Exit_SelectDATA:
    Exit Sub
    
Error_SelectDATA:
    Select Case Err.Number
        Case 1004
            ' Do nothing as long as the data is still getting to the tabs
        Case Else
            sMSG = "Error in SelectDATA: " & Err.Number & " " & Err.Description
            sTITLE = "Error"
            MsgBox sMSG, vbCritical, sTITLE
            Resume Exit_SelectDATA
    End Select
End Sub

 

[SkipVought]

OK. Check this out.

Private Sub ChangeDataConnection(sSQL As String, sWS As String)
On Error GoTo Error_SelectDATA

    ' Create a connection for each iteration through this sub.
    ' The connections will be deleted at wrap up.
    Dim sCONN As String
    
    ' Set up the connection string
    sCONN = "ODBC;DSN=Excel Files;"
    sCONN = sCONN & "DBQ=" & ActiveWorkbook.FullName & ";"
    sCONN = sCONN & "DefaultDir=" & ActiveWorkbook.Path & ";"
    sCONN = sCONN & "DriverId=790;MaxBufferSize=8000;PageTimeout=5;"
    
    'MODIFY the QueryTable CONNECTION
    With Sheets(sWS).QueryTables(1)
        .Connection = sCONN
        .CommandText = sSQL
        'run the query
        .Refresh False
    End With
    
Exit_SelectDATA:
    Exit Sub
    
Error_SelectDATA:
    Select Case Err.Number
        Case 1004
            ' Do nothing as long as the data is still getting to the tabs
        Case Else
            sMSG = "Error in SelectDATA: " & Err.Number & " " & Err.Description
            sTITLE = "Error"
            MsgBox sMSG, vbCritical, sTITLE
            Resume Exit_SelectDATA
    End Select
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

BTW, do NOT delete any QTs. Just run this to change each connection string.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Jean9]

I get the "Error in ChangeDataConnection: 9 Subscript out of range" error when trying to run the following code. The sub errors when it hits the
With Sheets(sWS).QueryTables(1) line:

Private Sub ChangeDataConnection(sSQL As String, sWS As String)
On Error GoTo Error_ChangeDataConnection

    ' Create a connection for each iteration through this sub.
    ' The connections will be deleted at wrap up.
    Dim sCONN As String
    
    ' Set up the connection string
    sCONN = "ODBC;DSN=Excel Files;"
    sCONN = sCONN & "DBQ=" & ActiveWorkbook.FullName & ";"
    sCONN = sCONN & "DefaultDir=" & ActiveWorkbook.Path & ";"
    sCONN = sCONN & "DriverId=790;MaxBufferSize=8000;PageTimeout=5;"
    
    'MODIFY the QueryTable CONNECTION
    With Sheets(sWS).QueryTables(1)
        .Connection = sCONN
        .CommandText = sSQL
        'run the query
        .Refresh False
    End With
    
Exit_ChangeDataConnection:
    Exit Sub
    
Error_ChangeDataConnection:
    Select Case Err.Number
        Case 1004
            ' Do nothing as long as the data is still getting to the tabs
        Case Else
            sMSG = "Error in ChangeDataConnection: " & Err.Number & " " & Err.Description
            sTITLE = "Error"
            MsgBox sMSG, vbCritical, sTITLE
            Resume Exit_ChangeDataConnection
    End Select
End Sub

 

[Jean9]

I ran through the original sub in order to establish the connections, then ran the macro with the sub you sent (the sub to remove the queries was commented out so the connections remained). The connections are named generically Connection, Connection1, Connection2, etc.

 

[SkipVought]

This IS Excel 2003, correct?

There IS a query table on the sheet, that has not been deleted?

Put a BREAK on your code ON the statement in question and in the DEBUG mode, use faq707-4594 to discover is there is indeed a QueryTable object on your sheet.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Jean9]

It was the blasted InitWorsheets routine that was being used to clear up the worksheet before putting the new query table on it...it was deleting the query table from the sheet prior to the macro run with the ChangeDataConnection sub in it (remember it had to be run once with the original sub so as to establish the query table on that sheet then I was running it a second time using the ChangeDataConnection sub). In any case, suffice it to say, when the query table is there, the code works beautifully but when it is not, it doesn't. I won't even begin to wonder why adding a table each time instead of just modifying one doesn't work for the whole adding and formatting a total label and field....

So as a recap for anyone else that might want to have multiple query tables in a workbook generated by code:
Do initially create connections by using some form of:

    ' Create a connection for each iteration through this sub.
    Dim sCONN As String, oQT As QueryTable
    
    ' Set up the connection string
    sCONN = "ODBC;DSN=Excel Files;"
    sCONN = sCONN & "DBQ=" & ActiveWorkbook.FullName & ";"
    sCONN = sCONN & "DefaultDir=" & ActiveWorkbook.Path & ";"
    sCONN = sCONN & "DriverId=790;MaxBufferSize=8000;PageTimeout=5;"
    
    'create the QueryTable object
    Sheets(sWS).Select
    Set oQT = ActiveWorkbook.ActiveSheet.QueryTables.Add( _
    Connection:=sCONN, _
    Destination:=Range("A8"), _
    Sql:=sSQL)
    With oQT
        ' User has already created and formatted column labels so do not
        ' use Query Table field names
        .FieldNames = False
        .BackgroundQuery = True
        .AdjustColumnWidth = False
        .Name = sWS
        'run the query
        .Refresh
    End With

After query tables are established use some form of the following to modify or in a sense "refresh" the established query tables:

    ' Create a connection for each iteration through this sub.
    Dim sCONN As String
    
    ' Set up the connection string
    sCONN = "ODBC;DSN=Excel Files;"
    sCONN = sCONN & "DBQ=" & ActiveWorkbook.FullName & ";"
    sCONN = sCONN & "DefaultDir=" & ActiveWorkbook.Path & ";"
    sCONN = sCONN & "DriverId=790;MaxBufferSize=8000;PageTimeout=5;"
    
    'MODIFY the QueryTable CONNECTION
    With Sheets(sWS).QueryTables(1)
        .Connection = sCONN
        .CommandText = sSQL
        'run the query
        .Refresh False
    End With

If there are non-query table rows that are added to the end of the query table, remember to delete the non-query row(s) before creating the new row(s). Do NOT delete the query table rows.

Thanks again, Skip!

 

[SkipVought]

Why would you even bother to code ADDing a query table. I could count the number of time I have had to do that on the fingers of one hand, one and a half at the most!

MODIFYing an existing QT's CommandText or Connection: COUNTLESS times! Maybe not as many as the sands of the sea or the stars in the sky, but certainly, more numerous that I could venture a guess.

Adding a QT: a ONE TIME thing.

Modifying a QT: a common occurrence.

I don't code ONE TIME THINGS!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Jean9]

I'm actually going to keep the whole adding a query table sub just in case the user inadvertently deletes the query table from the worksheet (I'm proof that this can happen because I accidently deleted the table when trying to delete that total row). The subscript out of range error in the ChangeDataConnection will be handled by adding the query table....

I didn't use to code one time things either until I started forgetting (after I'd walked away from the project for a bit) the necessary one time things that needed to happen before something else could happen, then I just started coding it more for reference than anything...a kind of in place tech manual of sorts...

 

[SkipVought]

okay. Sorry to rant. [rant] ;-)

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]