PDA

View Full Version : Coding Excel VBA: I copy & paste code, it doesn't work; try later, & it works



JeenLeen
2014-04-28, 02:37 PM
Earlier this afternoon, I posted a question (now in the spoiler below). In short, some VBA for Excel that wasn't working right, even though the code was basically a copy & paste of working code.

I opened the file anew just now and ran the code, and it worked fine. (Or as far as I can tell.) I changed some numbers in the file to check it, and it's still running fine.

Does VBA sometimes just need to be turned off and then re-opened to clear out some computational gunk? I've heard SAS (statistical programming language) sometimes can do that, if you run it enough times without shutting it down.


Edit: I noticed one of the highlighting was not actually working right. Re-ran it again and some work, some don't. All in the last row. It seems inconsistent with what isn't working right. Very frustrating to debug :smallsigh:


EDIT: I just retyped all the numbers in the last three rows. It color-coded everything correctly except for the very last cell (L285, or 12-285), which turned green when it should've turned red.

I'm making a VBA program to automate some calculations and color-coding. So far, it's been working great--or, with y'all's help, I've been able to get it to work great (http://www.giantitp.com/forums/showthread.php?343604-Excel-VBA-run-time-error-91)--but a recent thing is just flummoxing me.

I have about 5 tables that are identical in format for student demographics; each table deals with a different comparison. I'm copying & pasting them from Word into Excel, so I can run this code to calculate changes between years and the change in change, then I color-code accordingly. I got the code for the first one working, so it should work just to copy & paste the code and update the starting row/column positions. This has worked fine for about 3 tables. Then on the fourth, it starts messing up on the last row.
What should happen is: two cells are compared, and if the newer one is greater, it colors it red; if lesser, green; if they are equal, it leaves it without highlighting. What is happening is that the red and green are not coloring properly, but only in the last row calculated for.

I tried deleting the code for that table and copying & pasting anew, but the same thing happened. The only things I changed were what rowNum and colNum are set to, as well as the error/warning # I have some message boxes display (but the MsgBox shouldn't matter for this anyway).

I've even copied my code into Word and did a comparison to see if there's any other difference that crept in somehow. From the comparison, no extra changes crept in.
I *think* I noticed that the errors stopped/changed a bit when I typed something in one of the cells around there. Could it be a formatting thing, like the cell is text or isn't really reading a number as a number when it compares the two cells?
Any idea why this is happening?

Working code:


'Variables below are used for multiple tables
Dim ws As String, wValue As String
Dim rowNum As Integer, colNum As Integer 'sets row and column position
Dim dCalc As Double, d1 As Double, d2 As Double 'generic calculation to use for multiple programs
Dim Rng As Range 'coding note: you must use Set to put a cell's value to this, not simply =. Ex. Set Rng = Sheets().Cells(,)
ws = ActiveSheet.Name
Dim green As Long, red As Double, yellow As Long, blue As Long 'hard-coding color #s up here to make changing them easier later on
red = 0.399975585192419 'goes into the .Interior.TintAndShade
green = 5296274 'goes into the .Interior.Color
yellow = 65535 '.Interior.Color
blue = 15773696 '.Interior.Color


' I have a lot of code here for the other tables, but I'm skipping down to those in question

'Gap Comparison Results for Students with Disabilities. Range is A234 to L258 (L = 12)
colNum = 4 'increment by 2

Do While colNum < 13
rowNum = 238 'increment by 4
Do While rowNum < 259

'compare main group (rowNum - 2) to itself
Set Rng = Sheets(ws).Cells(rowNum - 2, colNum)
Rng.Select
If Sheets(ws).Cells(rowNum - 2, colNum) > Sheets(ws).Cells(rowNum - 2, colNum - 1) Then
Selection.Interior.Color = yellow
Else 'if got worse or stayed the same, no highlighting
Selection.Interior.ThemeColor = xlThemeColorDark1
End If

'compare secondary group (rowNum - 1) to itself
Set Rng = Sheets(ws).Cells(rowNum - 1, colNum)
Rng.Select
If Sheets(ws).Cells(rowNum - 1, colNum) > Sheets(ws).Cells(rowNum - 1, colNum - 1) Then
Selection.Interior.Color = blue
Else 'if got worse or stayed the same, no highlighting
Selection.Interior.ThemeColor = xlThemeColorDark1
End If

'calculate then compare the difference between the two groups (rowNum)
'calculate last year's difference & give warning if not the same as already in Excel sheet. Do not color-code.
Set Rng = Sheets(ws).Cells(rowNum, colNum - 1)
Rng.Select
d1 = Format(Sheets(ws).Cells(rowNum - 2, colNum - 1), "##0.0;-##0.0")
d2 = Format(Sheets(ws).Cells(rowNum - 1, colNum - 1), "##0.0;-##0.0")
dCalc = d1 - d2
If Format(Sheets(ws).Cells(rowNum, colNum - 1), "##0.0;-##0.0") <> Format(dCalc, "##0.0;-##0.0") Then
MsgBox "Warning: PASS Gap Race (SWD): this program calculated last year's gap differently than what was already there at row " & rowNum & " and column " & colNum - 1, , "warning message 3"
MsgBox "Program calculated: " & Format(dCalc, "##0.0;-##0.0") & ". Cell had: " & Sheets(ws).Cells(rowNum, colNum - 1), , "warning message 3 notes"
End If
Selection.NumberFormat = "@"
Sheets(ws).Cells(rowNum, colNum - 1) = Format(dCalc, "##0.0;-##0.0")
'calculate this year's difference & color-code accordingly
Set Rng = Sheets(ws).Cells(rowNum, colNum)
Rng.Select
d1 = Format(Sheets(ws).Cells(rowNum - 2, colNum), "##0.0;-##0.0")
d2 = Format(Sheets(ws).Cells(rowNum - 1, colNum), "##0.0;-##0.0")
dCalc = d1 - d2
Selection.NumberFormat = "@"
Sheets(ws).Cells(rowNum, colNum) = Format(dCalc, "##0.0;-##0.0")
If Sheets(ws).Cells(rowNum, colNum) > Sheets(ws).Cells(rowNum, colNum - 1) Then 'if gap increased (bad)
Selection.Interior.ThemeColor = xlThemeColorAccent2
Selection.Interior.TintAndShade = red
ElseIf Sheets(ws).Cells(rowNum, colNum) < Sheets(ws).Cells(rowNum, colNum - 1) Then 'if gap decreased (good)
Selection.Interior.Color = green
Selection.Interior.PatternColorIndex = xlAutomatic
Selection.Interior.TintAndShade = 0
ElseIf Sheets(ws).Cells(rowNum, colNum) = Sheets(ws).Cells(rowNum, colNum - 1) Then 'if gap unchanged
Selection.Interior.ThemeColor = xlThemeColorDark1
Else
MsgBox "error: PASS Gap Race (SWD): gap diff not calculated properly at row " & rowNum & "& col " & colNum, , "error message 22"
End If

rowNum = rowNum + 4
Loop
colNum = colNum + 2
Loop
colNum = 3 'set entire table to 0.0 format
Do While colNum < 13
rowNum = 236
Do While rowNum < 259
If Sheets(ws).Cells(rowNum, colNum) <> "" Then 'if not blank
Set Rng = Sheets(ws).Cells(rowNum, colNum)
Rng.Select
Selection.NumberFormat = "@"
Sheets(ws).Cells(rowNum, colNum) = Format(Sheets(ws).Cells(rowNum, colNum), "##0.0;-##0.0")
End If
rowNum = rowNum + 1
Loop
colNum = colNum + 1
Loop




And here it screws up on the last row, which is basically a copy & paste from above:


'Gap Comparison Results for LEP. Range is A261 to L285 (L = 12)
colNum = 4 'increment by 2

Do While colNum < 13
rowNum = 265 'increment by 4
Do While rowNum < 286

'compare main group (rowNum - 2) to itself
Set Rng = Sheets(ws).Cells(rowNum - 2, colNum)
Rng.Select
If Sheets(ws).Cells(rowNum - 2, colNum) > Sheets(ws).Cells(rowNum - 2, colNum - 1) Then
Selection.Interior.Color = yellow
Else 'if got worse or stayed the same, no highlighting
Selection.Interior.ThemeColor = xlThemeColorDark1
End If

'compare secondary group (rowNum - 1) to itself
Set Rng = Sheets(ws).Cells(rowNum - 1, colNum)
Rng.Select
If Sheets(ws).Cells(rowNum - 1, colNum) > Sheets(ws).Cells(rowNum - 1, colNum - 1) Then
Selection.Interior.Color = blue
Else 'if got worse or stayed the same, no highlighting
Selection.Interior.ThemeColor = xlThemeColorDark1
End If

'calculate then compare the difference between the two groups (rowNum)
'calculate last year's difference & give warning if not the same as already in Excel sheet. Do not color-code.
Set Rng = Sheets(ws).Cells(rowNum, colNum - 1)
Rng.Select
d1 = Format(Sheets(ws).Cells(rowNum - 2, colNum - 1), "##0.0;-##0.0")
d2 = Format(Sheets(ws).Cells(rowNum - 1, colNum - 1), "##0.0;-##0.0")
dCalc = d1 - d2
If Format(Sheets(ws).Cells(rowNum, colNum - 1), "##0.0;-##0.0") <> Format(dCalc, "##0.0;-##0.0") Then
MsgBox "Warning: PASS Gap Race (LEP): this program calculated last year's gap differently than what was already there at row " & rowNum & " and column " & colNum - 1, , "warning message 4"
MsgBox "Program calculated: " & Format(dCalc, "##0.0;-##0.0") & ". Cell had: " & Sheets(ws).Cells(rowNum, colNum - 1), , "warning message 4 notes"
End If
Selection.NumberFormat = "@"
Sheets(ws).Cells(rowNum, colNum - 1) = Format(dCalc, "##0.0;-##0.0")
'calculate this year's difference & color-code accordingly
Set Rng = Sheets(ws).Cells(rowNum, colNum)
Rng.Select
d1 = Format(Sheets(ws).Cells(rowNum - 2, colNum), "##0.0;-##0.0")
d2 = Format(Sheets(ws).Cells(rowNum - 1, colNum), "##0.0;-##0.0")
dCalc = d1 - d2
Selection.NumberFormat = "@"
Sheets(ws).Cells(rowNum, colNum) = Format(dCalc, "##0.0;-##0.0")
If Sheets(ws).Cells(rowNum, colNum) > Sheets(ws).Cells(rowNum, colNum - 1) Then 'if gap increased (bad)
Selection.Interior.ThemeColor = xlThemeColorAccent2
Selection.Interior.TintAndShade = red
ElseIf Sheets(ws).Cells(rowNum, colNum) < Sheets(ws).Cells(rowNum, colNum - 1) Then 'if gap decreased (good)
Selection.Interior.Color = green
Selection.Interior.PatternColorIndex = xlAutomatic
Selection.Interior.TintAndShade = 0
ElseIf Sheets(ws).Cells(rowNum, colNum) = Sheets(ws).Cells(rowNum, colNum - 1) Then 'if gap unchanged
Selection.Interior.ThemeColor = xlThemeColorDark1
Else
MsgBox "error: PASS Gap Race (LEP): gap diff not calculated properly at row " & rowNum & "& col " & colNum, , "error message 23"
End If

rowNum = rowNum + 4
Loop
colNum = colNum + 2
Loop
colNum = 3 'set entire table to 0.0 format
Do While colNum < 13
rowNum = 263
Do While rowNum < 286
If Sheets(ws).Cells(rowNum, colNum) <> "" Then 'if not blank
Set Rng = Sheets(ws).Cells(rowNum, colNum)
Rng.Select
Selection.NumberFormat = "@"
Sheets(ws).Cells(rowNum, colNum) = Format(Sheets(ws).Cells(rowNum, colNum), "##0.0;-##0.0")
End If
rowNum = rowNum + 1
Loop
colNum = colNum + 1
Loop

Jasdoif
2014-04-28, 06:11 PM
Edit: I noticed one of the highlighting was not actually working right. Re-ran it again and some work, some don't. All in the last row. It seems inconsistent with what isn't working right. Very frustrating to debug :smallsigh:With as much cell-driven logic you've got in there, it's extremely difficult to tell anything without having some cell values to look at.

I'd have to guess some of your other code (that your comment says you "skipped") is erroneously changing some of the same cells as this one. If that last row is the only one with errors, maybe you've got a starting row index off somewhere?

JeenLeen
2014-04-29, 09:19 AM
Yeah; I realize this is a hard one to relay just with the code. It's a big table, so I'm hesitant to wrangle with the Table code to present it here.


I tried commenting out everything else except the opening declarations and the table with the bug. When I did so, it still has the same bug. So it's not something in another section of the code messing with this part.

Odd, too, was that I added the 5th table. (The one with the bug is table 4 of 5, all using the same recycled code.) I created the 5th one twice, once recycling code from table 1 and one using the buggy code. The 5th one is running fine either way (though I reverted to the copying & pasting the non-buggy code just to be safe).

CarpeGuitarrem
2014-04-29, 10:28 AM
I feel like pointing out that, since technology is partially driven by Quantum Chaos Magic, such behavior is not unexpected at all. :smallbiggrin: This is just the digital version of "give it a good kick". :smallwink:

JeenLeen
2014-04-29, 11:57 AM
I feel like pointing out that, since technology is partially driven by Quantum Chaos Magic, such behavior is not unexpected at all. :smallbiggrin: This is just the digital version of "give it a good kick". :smallwink:

I think I can use it as is, but with the caveat of "make sure to check that row manually", but I'd rather not go to my boss with that answer :smallbiggrin:

One debugging idea I had was to isolate the color-coding code, since it's that which is bugging (albeit only bugging in one row, maybe one cell now, in one table). But this would at least let me rule out that the color-coding code is what is messing up, instead of the row/column iterations or the If-Then logic.
My idea was to have GoTo (until I found out how terrible they are and there isn't any 'now go back to where you came from' line), so I think I want to call a procedure/function to color-code. My idea is something like this (the functions are what I will use in my main program; the below was something to test out function use)


Option Explicit
Public Function FcnGreen(ByVal Rng2 As Range)
Rng2.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Function


Public Function FcnRed(ByVal Rng2 As Range)
Rng2.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
End Function


Public Function FcnClear(ByVal Rng2 As Range)
Rng2.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Function

Sub Macro4()



Dim Rng As Range, ws As String
Dim rowNum As Integer
rowNum = 1
ws = ActiveSheet.Name

Do While rowNum < 100
Set Rng = Sheets(ws).Cells(rowNum, 3) 'row 3
If Sheets(ws).Cells(rowNum, 3) = 30 Then
FcnGreen (Rng)
ElseIf Sheets(ws).Cells(rowNum, 3) = 80 Then
FcnRed (Rng)
Else
FcnClear (Rng)
End If

rowNum = rowNum + 1
Loop

MsgBox rowNum

End Sub


But it gives me an error when I try to call the functions. Run-time error 424: Object required. How does one properly call a function, and is calling a function what would help with this?
And is "Option Explicit" needed? Something I saw online seemed to imply I should add it, but I have no clue what it means and it doesn't seem to help or hurt.

My goal is to have the color-coding code just show up at the top (or bottom? which is better) once, then each table's code calls the appropriate function. That way, if not everything is bugging out, I can be sure it's not something weird with the copy & paste of color-coding, but something weird with the copy & paste of If-Thens.

Jasdoif
2014-04-29, 12:33 PM
But it gives me an error when I try to call the functions. Run-time error 424: Object required. How does one properly call a function, and is calling a function what would help with this?This is a Visual Basic thing, a method declared with "Function" has to return something. Since you're not returning anything, you want to use "Sub" instead of "Function".

And is "Option Explicit" needed? Something I saw online seemed to imply I should add it, but I have no clue what it means and it doesn't seem to help or hurt.It's not required, but highly recommended. It forces all variables to be declared prior to use; without it, a typo could be silently declared as a new variable on the spot, which really complicates debugging since you'll have no idea that it happened until/unless you find that typo.

JeenLeen
2014-04-29, 01:46 PM
EDIT
I got the main issue debugged. It turned out that the problem was I was comparing two cells, not two doubles. I had to assign the values of the cells to d1 and d2, then compare them. Otherwise, sometimes 9.6 would be greater than 15.6, to give an example.

I also created a Sub that I could Call 5 times instead of copying & pasting the code 5 times. Must cleaner.


---

Thank you. I've heard of Option Explicit, but not utilized it before.

I also had to add the 'Call' line, but that worked great. I'll integrate it into my main program and see if that helps the debugging.

Working color-code code:

Option Explicit
Public Sub FcnGreen(ByVal Rng2 As Range)
Rng2.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub


Public Sub FcnRed(ByVal Rng2 As Range)
Rng2.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
End Sub


Public Sub FcnClear(ByVal Rng2 As Range)
Rng2.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

Sub TestColorCode()

Dim Rng As Range, ws As String
Dim rowNum As Integer
rowNum = 1
ws = ActiveSheet.Name

Do While rowNum < 100
Set Rng = Sheets(ws).Cells(rowNum, 3) 'row 3
If Sheets(ws).Cells(rowNum, 3) = 30 Then
Call FcnGreen(Rng)
ElseIf Sheets(ws).Cells(rowNum, 3) = 80 Then
Call FcnRed(Rng)
Else
Call FcnClear(Rng)
End If

rowNum = rowNum + 1
Loop

MsgBox rowNum

End Sub