A few years back I built a interactive heatmap in Excel with Freeforms forming a complete map of the country with all regions.
Every region has a specific KPI percentage, which on it's turn colours the freeform shapes via a VBA macro.
However, I now keep running in a Run-time error '5': Invalid procedure call or argument and I cannot find the bug in the code.
Does anyone see what I don't?
Sub HEATMAP()
For i = 1 To 139
a = Sheet3.Cells((1 + i), 6)
b = Sheet3.Cells((1 + i), 5) * 28 - 28
c = Sheet3.Cells((1 + i), 5) * 28 - 9
d = 89 - Sheet3.Cells((1 + i), 5) * 9 - 9
Sheet2.Shapes.Range(Array("Freeform " & a)).Line.ForeColor.RGB = RGB(80, 80, 80)
Sheet2.Shapes.Range(Array("Freeform " & a)).Fill.ForeColor.RGB = RGB(b, c, d) "<- this line produces the error"
Next i
ActiveWorkbook.RefreshAll
End Sub
Sheet 3 contains a list of all the regions with their freeform-name of each region's object and their KPI percentage, brought back to 10 categories (one for each 10% bracket), which should return a specific color.
This color should be calculated with the values b, c and d in the VBA. (from lowest bracket: yellow to highest bracket: green)
The sheet contains a header.
The 5th column has the colour bracket (numbered 10 - 1, with 10 as the worst bracket [0-10%] and 1 as the best bracket [90-100%])
The 6th column has the freeform number of the objects, creating the map.
There are a total of 139 regions (and therefore freeforms)
Sheet 2 contains the map with a button which triggers this VBA, so the user can "colour the map" with it, based on the KPI values.
What do I keep missing?
Thanks in advance!
As big ben says, what are b, c and d when the error hits?
Might want to wrap it with an
On Error GoTo ErrorHandler1
Sheet2.Shapes.Range(Array("Freeform " & a)).Fill.ForeColor.RGB = RGB(b, c, d) '<- this line produces the error
dummy = 1 'Just a dummy line so you can resume out of the error and see what inputs produced the invalid input val
Exit Sub
ErrorHandler1:
stophere = 1 (and put a breakpoint on this line)
Resume Next
That's a slightly ugly way of getting into the code on the iteration its falling apart and letting you look around for both the invalid value and where its coming from.
Related
I am trying to add few jpeg pictures (up to 6) from excel worksheet in a table (word document), but only one appears at the end. Each time I am adding a picture it goes over the previous one. Here a part of my code with the issue:
' Filling the table
For i = 1 To iNumChem
' Column 1
wdTable.Rows(i + 1).Cells(1).Range.Text = Sheet1.Cells(a + 1 + 2 * i - 2, 5).Value
' Column 2
wdTable.Rows(i + 1).Cells(2).Range.Text = Sheet1.Cells(a + 1 + 2 * i - 2, 31).Value
' Column 3
For p = 0 To 5
If Sheet1.Cells(a + 2 * i, 5 + 2 * p).Value <> 0 Then
Sheet3.Shapes(Sheet1.Cells(a + 2 * i, 5 + 2 * p).Value).Copy
wdTable.Rows(i + 1).Cells(3).Range.PasteSpecial
End If
Next p
' Column 4
Next i
I tried to work with the properties ParagraphFormat and Move, but it didn't help.
I usually find difficult to move "the cursor" to the right position to be able to add something, especially in this case with Pictures (not Shapes) to add side by side.
Any ideas/comments are welcome.
Note: Edited after comments as I mixed the terms shape and picture!
I am trying to take pictures from Excel and add them in the same cell of a table word.
When you paste the shape it won't be in the cell, it will be anchored to it but float above it. This is just the same as in Excel where the shape floats above the worksheet and hides the cells below it.
To have the shape in the table you'll need to set the wrap type to inline, otherwise the shapes will stack up on top of each other.
With wdTable.Rows(i + 1).Cells(3).Range
.PasteSpecial
.ShapeRange(1).WrapFormat.Type = wdWrapInline
End With
EDIT:
Pictures are pasted into Word as InlineShapes. They do not stack up one on top of the other. If you attempt to paste more than one into wdTable.Rows(i + 1).Cells(3).Range each one will overwrite the last. Instead you need to declare a variable outside the loop, something like wdCellRange as Word.Range, and then use it when inserting the pictures, e.g.
Set wdCellRange = wdTable.Rows(i + 1).Cells(3).Range
With wdCellRange
.Collapse Direction:= wdCollapseEnd
.PasteSpecial
End With
You could try:
...Range.Collapse Direction:= wdCollapseEnd
I am currently having to attach many pictures (jpeg) to an excel document and exporting it as a pdf. I need one picture per page.
I was using the following code, but with no avail.
For j = 0 To i
Cells(2, 1).Activate
Let pm = "Q:\Public\ACCE LINEAR\IRAD Photomics\A 350 Frame Photomics " & dat & "\" & sn & "\PHOTOMICS" & j & ".jpg"
ws1.Pictures.Insert(pm).Select
incr = 660 * (j + 1)
Selection.ShapeRange.IncrementTop incr
Next j
I activate Cell A2 so that the picture will initially be placed in the same spot every time. I then move the picture down a certain amount as defined by the variable "incr". At first I toyed with that number (660) until it worked and then went on to the next report. The problem is that what works for one report doesn't work for another.
I find this surprising as I have my print area (I believe that dictates the length of a page) set to incorporate all columns. Although each report has a unique amount of rows, they each have exactly the same amount of columns. Therefore, the print area should be the same from sheet to sheet and each picture is exactly the same size so that number shouldn't have to change from report to report.
I still don't understand why my previous spacing idea didn't work when the print area from sheet to sheet is exactly the same. However, knowing the print area is the same I instead made the top left cell in each page active and inserted each picture into that cell. This ensured that the pictures did not get cut when the excel file was exported as a PDF.
Here is the code I used. There are a few variable that were defined earlier in the code, but you should get the idea
b = counter - 1
For j = 0 To b
a = j + 1
If i > 24 Then a = j + 2
incr = (42 * a) - j
Cells(incr, 1).Activate
ws1.Pictures.Insert(MyFolder & "\" & PMArray(j)).Select
Next j
I am working on a macro to format and extract information from a number of word documents that all have 1 table in it. The problem is that this table has many rows, and each each row has either 1, 2, or 3 columns in it, and I need to ensure that the right edge of the table is always the same width.
The actual behaviour that I want to replicate in VBA code is when you drag the little square thing on the ruler bar in word (that represents the right edge of the table) to adjust the right edge of the table for all rows. However, when I try and record a macro, it generates the following line of code, which does not work for tables with merged columns:
Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=501.3, RulerStyle:= _
wdAdjustNone
Next I tried to explicitly target just the first row using the following code. This worked, but it only resized the width for the first row - all of the other rows were unchanged:
wdApp.Documents(myDoc).Tables(1).Cell(1, 1).SetWidth ColumnWidth:=501.3, RulerStyle:=_
wdAdjustNone
I then played around with the .width property, rather than the .setwdith property, but they seemed to behave the same. I even tried all four .setwidth RulerStyle parameters but they all behaved the same.
Finally, in frustration, I decided to loop through all of the rows in the table, and resize the rightmost column as needed so the entire row is my desired 501.3 pixels. This took some doing, as I could not find a way to tell how many columns are on a given row. I ended up relying on trapped errors to solve the issue - see below. The 4th row will error when there are not enough columns on that row, so I simply reduce the i variable and try again until there is no error:
On Error GoTo BadExit
For row = 1 To wdApp.Documents(myDoc).Tables(1).Rows.count
i = 3
If wdApp.Documents(myDoc).Tables(1).Cell(row, i).PreferredWidth <> 1501.3 Then
If i = 3 Then
wid = 501.3 - wdApp.Documents(myDoc).Tables(1).Cell(row, 2).Width - wdApp.Documents(myDoc).Tables(1).Cell(row, 1).Width
wdApp.Documents(myDoc).Tables(1).Cell(row, i).Width = wid
ElseIf i = 2 Then
wid = 501.3 - wdApp.Documents(myDoc).Tables(1).Cell(row, 1).Width
wdApp.Documents(myDoc).Tables(1).Cell(row, i).Width = wid
Else
wid = 501.3
wdApp.Documents(myDoc).Tables(1).Cell(row, i).Width = wid
End If
End If
GoTo SafeExit
BadExit:
If i = 3 Then
i = 2
Resume
ElseIf i = 2 Then
i = 1
Resume
End If
SafeExit:
Next row
This code runs through with no errors however the final width never seems to be 501.3 - it seems to vary inconsistently (which I confirmed by using msgbox with the .width property), and also, sometimes the right edges are not lined up! The rows with 1 column may stick out a bit further than the rows with 2 columns, etc. And this code is very slow.
Can anybody help me find a simple solution to replicate the behavior of manually using your mouse to move the right square on the ruler to adjust the width of every row in a word table to a specific value? Your help would be greatly appreciated.
Thanks in advance,
-Josh
I have to adjust sales volumes so that
1) I do not use up my daily capacity and
2) I do not run out of window by the end of the month
I need two criteria and to run until it either hits my end date or runs out of window at the end of the month.
Dates are in column A.
I have
Sub CashCalib()
Set Window = Sheets("inventory").Range("AX124")
Set Capacity = Sheets("Inventory").Range("BU95")
Set Sales = Sheets("Inventory").Range("BV95")
Set EndDate = Sheets("inputs").Range("A1")
Do Until Sales.Offset(0, -74) = EndDate
Capacity.GoalSeek _
Goal:=0 And Window.Value > 0, _
ChangingCell:=Sales
Loop
End Sub
I get
run time error 1004 application defined or object defined error
on the do until line.
Your Sales.Offset(0, -74) is moving left too far as you do not have 74 columns to go left. If you meant to move up then do Sales.Offset(-74, 0) or change to which value you need to move up. Just remember that there is not a 0 row or column in excel like many other languages.
You were receiving a Error 1004 Object error because you were offsetting one column too many. By offsetting Column BV (the 74th column) -74 columns, you were offsetting to column 0, which doesn't exist.
Modify your Do Until line to look like this:
Do Until Sales.Offset(-94, -73) = EndDate
First of all I have no idea of writing macros in excel, but now I have to write a code for a friend. So here we go.
In my excel sheet I have a table which holds some producers as columns and 12 months of the year as rows. In their intersecting cell it's written the amount of products produced by the producer during that month. Now I need to find maximum and minimum values of produced goods within each month and output the producers of that goods.
I found a code for a similar problem, but I don't understand it clearly and it has errors.
Here is the code:
Sub my()
Dim Rng As Range, Dn As Range, Mx As Double, Col As String
Set Rng = Range(Range("A1"), Range("A6").End(xlUp))
ReDim ray(1 To Rng.Count)
For Each Dn In Rng
Mx = Application.Max(Dn)
Select Case Mx
Case Is = Dn.Offset(, 0): Col = "A"
Case Is = Dn.Offset(, 1): Col = "B"
Case Is = Dn.Offset(, 2): Col = "C"
Case Is = Dn.Offset(, 3): Col = "D"
End Select
ray(Dn.Row - 1) = Col
Next Dn
Sheets("Sheet2").Range("A2").Resize(Rng.Count) = Application.Transpose(ray)
End Sub
I get the following error:
Run-time error'9': Subscript out of range.
So my question is, what does this error mean and what do I need to change in this code to work?
EDIT1:
OK, now the error is gone. But where do I get the results?
EDIT2
I know this line is responsible for inserting the results in specified place, but I cant see them after execution. What's wrong with that?
Error means the array you are trying to access has not been defined to contain the ordinal you're looking for: For example Array 10 has positions 0-9 so if I try and access array(10) it would throw that error or array(-1) it would throw that error.
I can't remember if excel is 0 or 1 based arrays.
Possibly change
ray(Dn.Row - 1) = Col
to
if dn.row-1<> 0 then ' or set it to <0 if zero based.
ray(Dn.Row - 1) = Col
end if
You don't need VBA (a macro) to do this. It can be done using a worksheet formula.
E.g.
If your producers are P1,P2,P3,P4 and your sheet looks like this:-
A B C D E F
+-------------------------------------------
1 | Month P1 P2 P3 P4 Top Producer
2 | Jan 5 4 3 2
3 | Feb 2 3 5 1
4 | Mar 6 4 4 3
...
...
The following formula placed in cells F2,F3,F4,... will pick out the top producer in each month.
=INDEX($B$1:$E$1,MATCH(MAX(B2:E2),B2:E2,0))
Generally it's better to try and use built in Excel functionality where possible. Resort to VBA only if you really need to. Even if you were to use the top producer/month data for some other operation which is only possible in VBA, at least the top producer/month data derivation is done for you by the worksheet, which will simplify the VBA required for the whole process.
Transposing a range can also be done using a worksheet formula by using the TRANSPOSE() function.
BTW - I'm not sure what you want to do if two producers have the same output value. In the VBA example in your question, the logic seems to be:- if two producers are joint top in a month, pick the first one encountered. The formula I've given above should replicate this logic.
I have used these functions quite extensively and they are very reliable and fast:
Public Function CountRows(ByRef r As Range) As Integer
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End Function
Public Function CountColumns(ByRef r As Range) As Integer
CountColumns = r.Worksheet.Range(r.End(xlToRight), r).Columns.Count
End Function
Give it a reference (ex. "A2") and it will return the filled cells down, or the the right until and empty cell is found.
To select multiple sells I usually do something like
Set r = Range("A2")
N = CountRows(r)
Set r = r.Resize(N,1)