I'm having trouble fitting my columns in Excel on a sheet.
I have a sheet with columns from A to CK (can be different per project).
I don't need to print column A, but column B has to be on all pages and next to column B has to be 3 columns. So that will make column "B,C:E" on first page, next page "B,F:H", and so on... Column B is set as title, so it will be printed on every page.
My problem is to set the scale. What I'm doing:
Take pagesize and translate to points, take off margin left and margin right = my printable area
Get the width of range("B:E") = my range to fit the page
Divide my printable area by my range to fit, multiply that with 100%, and extract 1% to make sure it will fit
The outcome in my situation is 83, but is has to be 77 to fit the page. I'll have to find other numbers I think, but I don't know how and which...
My code:
If ActiveSheet.Name = "Meterkastlijst" Then
Dim lngZoom As Long
Dim lngKolB As Long
Dim lngPagB As Long
lngKolB = ActiveSheet.Range("B:E").Width
If ActiveSheet.PageSetup.PaperSize = xlPaperA4 Then
lngPagB = CLng(Application.CentimetersToPoints(21)) - CLng((ActiveSheet.PageSetup.LeftMargin + ActiveSheet.PageSetup.RightMargin))
ElseIf ActiveSheet.PageSetup.PaperSize = xlPaperA3 Then
lngPagB = CLng(Application.CentimetersToPoints(29.7)) - CLng((ActiveSheet.PageSetup.LeftMargin + ActiveSheet.PageSetup.RightMargin))
End If
If lngPagB <> 0 And lngKolB <> 0 Then
lngZoom = ((lngPagB / lngKolB) * 100) - 1
With ActiveSheet.PageSetup
.Zoom = lngZoom
End With
End If
End If
Different widths:
Column B: 45 (319 pixels) -> in Excel, set with VBA
Column C: 15 (109 pixels) -> in Excel, set with VBA
Column D: 30 (214 pixels) -> in Excel, set with VBA
Column E: 20 (144 pixels) -> in Excel, set with VBA
Column B-E: 589 points -> with VBA
Page: 21 centimeters (595 points)
Margins (left & right): 1.8 centimeters (50.4 points)
Print area: 595 - 101 (100.8) = 494 points
With numbers above it calculates 83%, but then it doesn't fit, when I set it manually to 77% it does fit, but how can I get this number with VBA? I don't understand the column widths, what I see in Excel and how I set it in VBA (45+15+30+20) is different from what VBA tells me it should be (589)...
Column Width Units
Column width is measured in Characters, Points, Centimeters / Inches, Pixels, ...
Column width in Characters
If you set a column width by manual value input or by mouse, you see the "amount of standard font number characters". Please refer to Microsoft support for details.
This value can be read and written in VBA: .Range.ColumnWidth = 10.78.
The maximum value is 255.
Column width in Points
This is an internal value not shown in GUI during manual resize of a column.
It corresponds to 72 points per inch.
In VBA it can only be read: .Range.Width
Column width in Pixels
Excel shows the column width in pixels (in parentheses) during manual resize of a column width in normal view. This value can not be read or written directly in VBA.
Column width in Centimeters or Inches
During manual resize within the page layout view Excel shows column width in centimeters (or inches) instead of pixels.
Only this value depends on print zoom level!
The measurement unit itself can be read in VBA:
Application.MeasurementUnit ' 0 = xlInches, 1 = xlCentimeters, 2 = xlMillimeters
Conversion Formulas
By this you may check or verify all values in your environment:
Dim ScreenResolution As Double
Dim ColumnWidthChars As Double
Dim ColumnWidthPoints As Double
Dim ColumnWidthPixels As Double
Dim ColumnWidthInches As Double
Dim ColumnWidthCentimeters As Double
ScreenResolution = 120 ' normal (96 dpi) or large (120 dpi)
ColumnWidthChars = ActiveSheet.Columns(1).ColumnWidth
ColumnWidthPoints = ActiveSheet.Columns(1).Width
ColumnWidthPixels = (ColumnWidthPoints / 72) * ScreenResolution
ColumnWidthInches = ColumnWidthPoints / 72 * ActiveSheet.PageSetup.Zoom / 100
ColumnWidthCentimeters = ColumnWidthInches * 2.54
Debug.Print ColumnWidthChars, ColumnWidthPoints, ColumnWidthInches, _
ColumnWidthCentimeters, ColumnWidthPixels
ScreenResolution may be retrieved with API function GetDeviceCaps(hDC, 88)
Rounding Effects
Excel stores the character-based .Range.ColumnWidth with decimals for each relevant column in the workbook file. If you set it to 100, it is stored as e. g.
<cols><col min="1" max="1" width="100.77734375" customWidth="1"/></cols>
After reopening this file, the reported .ColumnWidth is 100 without decimals.
If you set a large column width and switch between normal view and page layout view, then you may register difference of about 2% between the measures (.Range.Width and pixels suddenly change) - but all values still correspond to each other according to above formulas.
Display Scaling Dependency
All different column width values are independent of Excel's view zoom level and/or Windows 10 display scaling.
Print Zoom Dependency
Only the inch- and centimeter values change, if you change the print zoom level.
But you get more or less columns i. e. amount of points on your paper.
Excel measures .PageSetup.Leftmargin in points (with a scale of 72 points per inch). This corresponds to .Range.Width which is also measured in points.
Example: If I set both paper margins to 5.5 cm, then the resulting A4 paper width of 10 cm holds e. g. two columns with a total .Width of appr. 283 points which corresponds to 72 points/inch.
If I set the print zoom to 83 percent a .Width of appr. 340 points is maximum, and at a print zoom of 30 % it's almost 943 points.
Print Scaling
The calculation of a print zoom factor is
WorkSheet.PageSetup.Zoom = (PageWidthInPoints / AllColumnsWidthInPoints) * 100
Your calculation seems to be correct, but I would subtract at least 2 % (see rounding effects above).
So VBA is completely new to me. I come from a C# background.
Currently creating an order form, whereby I can input the total amount I require of an object and then the price is calculated in a different cell.
However I also want the price to change based off amount thresholds for that object.
Say for example 0 - 100 will cost £2.50 so I expect the answer to be anywhere within that range is multiplied by 2.50. Meanwhile if the amount exceeds 100 and becomes 120 I want the object price to now reflect £2.30 and proceed to multiple the 120 by £2.30.
I've noticed a few tutorials on line but they don't exactly explain how I might be able to achieve the above. Wondering if anyone can point me in the right direction?
Non VBA Soluion
If you build a table with the bottom and upper thresholds for a price, you can simply use a VLOOKUP and return the approximate match.
In photo, Column C is the output from the equation that is shown in Column D
VBA Solution
You can also use a simple UDF. Paste the code inside a Module and then you can call the function PRICEINDX from a cell just like any other equation. You can either manually type in a value like PRICEINDX(164) or select a cell that has the value to be tested like PRICEINDX(A1)
You can also set up more complex thresholds easily by using Select Case
Option Explicit
Public Function PRICEINDX(Target As Double) As Double
Dim ans As Double
Select Case Target
Case 0 To 100
ans = 2.5
Case 101 To 200
ans = 2.3
Case 201 To 300
ans = 2.1
Case Is > 300
ans = 2
End Select
PRICEINDX = ans
End Function
90% + Ist Division
71% - 90 % IInd Division
40% - 70% IIIrd Division
< 40% Fail
Nested if excel formula for excel for above condition .
I applied below formula but seems to be not correct:
=IF(AND(i4>=40%,i4<=70%),"3rd",IF(AND(i4>=71%,i4<=90%),"2nd",IF(i4>90%,"ist"),IF(i4<40%,"fail")))
Start at the top:
=IF(I4>.9,"1st",IF(I4>=.71,"2nd",IF(I4>=.4,"3rd","FAIL")))
This way one only needs to step through the lowest threshold. Once one of the Ifs returns true it will not do the others.
I'm looking to color a table of values in Excel 2010 by their absolute value. Basically, if I have the table:
...the cells are colored by the cell's raw value. What I would like to do is color by the cell's absolute value, so with the cell coloring of this table:
...but with the values of the first table (the real values). Any ideas on how one might do this? Through the GUI or with VBA?
I don't think that there is any way to do this with three colors (red, yellow, green), but you can do it with two colors (for example yellow and green). Simply make the color for the low value and the color for the high value the same. That way, the cells with the lower absolute value will have the middle color and cells with the higher absolute value will have the other color.
Select Your data
Conditional Formatting
Color Scale
More Rules
Select "3-Point Scale" under Format Style
Change the colors so that the Maximum and Minimum colors are the same
Here is my solution to this problem. The conditional format formula reads
=AND(ABS(B3)>0,ABS(B3)<=500)
for the darkest green, the scale changes to 500 to 1000, 1000 to 1500, and finally 1500 to 2000 for the red band.
Conditional Formats
Color Scale Values
Here is a picture of the dataset that I used to test these conditional formats:
A variation on this simple conditional formatting illustration may work for you.
Highlight the whole of the data range (you need the top LH cell to be the anchor for relative addressing) and enter the Formula: in 'relative notation' i.e. cell references without the dollar signs. You also have to consider the order of the rules.
The uppermost formula is obscured but reads =(ABS(B3)>39) * (ABS(B3)<41) Note that the * symbol applies an AND operation.
Ok, I have a solution that works with 3 color conditioning. Basically you supply a region to my code. It then creates two ranges, one of neg numbers and one of positive ones. It then applies conditional formatting
red-low yellow-mid green-high to the positive range and
red-high yellow-mid green-low to the negative range.
It was a quick solution so its sloppy and not robust (for instance it only works in columns A-Z because of a lazy ascii conversion for column numbers), but it works. (i'd post a pic but I don't have enough points)
---------------------edit-------------------------------
#pnuts is right, unless the data is symmetric this solution wont work as is. so with that in mind I came up with a new solution. First I will explain the general idea, then basically just dump the code, if you understand the logic the code should be fairly clear. It is a rather involved solution for such a seemingly simple problem, but isn't that always the way? :-P
We are still using the basic idea of the original code, create a negative range and apply colorscale to it, then create a positive range and apply the inverted color scale to it. As seen below
Negative ........... 0 ................ positive
green yellow red | red yellow green
So with our skewed data data_set={-1,-1,-2,-2,-2,-2,-3,-4,1,5,8,13} what I do is mirror the the extreme value. In this case 13, so now data_set={-13,-1,-1,-2,-2,-2,-2,-3,-4,1,5,8,13} Notice the additional -13 element. I assume you have a button to enact this macro so I store the extra -13 in a cell that is underneath the button so even though its there it isn't visible (yeah I know they can move the button etc, but it was the easiest thing I could think of)
Well that's all well and good green maps to 13 AND -13 but the color gradient is based on percentiles (in fact the color bar code uses the 50th percentile to determine the midpoint, or in our case where the yellow section is)
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
so with our distribution {-13,-1,-1,-2,-2,-2,-2,-3,-4,1,5,8,13} we could start seeing the yellow in the positive range around the number 8.5 Since 8.5 is 50th percentile. but in the neg range (even if we add a mirrored -13) the 50th percentile is -2, so our yellow in the negative range would start at 2!! Hardly ideal. just like pnuts mentioned, but we are getting closer. if you have fairly symmetric data this issue won't be present, but again we are looking at worst case of skewed datasets
What I did next is statistically match the midpoints....or at least their colors. So since our extreme value (13) is in the positive range we leave the yellow at the 50th percentile and try to mirror it to the negative range by changing what percentile the yellow color appears at (if the negative range had the extreme value we would leave the yellow at that 50th percentile and try to mirror it to the positive range). That means in our negative range we want to shift our yellow (50th percentile) from -2 to a number around -8.5 so it matches the positive range. I wrote a function called
Function iGetPercentileFromNumber(my_range As Range, num_to_find As Double) That does just that! More Specifically it takes a range and reads the values into an array. It then adds num_to_find to the array and figures out what percentile num_to_find belongs to as an integer 0-100 (hence the i in the function name). Again using our example data we would call something like
imidcolorpercentile = iGetPercentileFromNumber(negrange with extra element -13, -8.5)
Where the -8.5 is the negative(50th percentile number of positive range = 8.5). Don't worry the code automatically supplies the ranges and the numbers, this is just for your understanding. The function would add -8.5 to our array of negative values {-13,-1,-1,-2,-2,-2,-2,-3,-4,-8.5} then figure out what percentile it is.
Now we take that percentile and pass it in as the midpoint for our negrange conditional formatting. so we changed the yellow from 50th percentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
to our new value
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = imidcolorpercentile 'was 50
which now deskewed the colors!! we have basically created a symmetric in appearance color bar. Even if our numbers are far from symmetric.
Ok, I know that was a TON to read and digest. but here are the main takeaways this code
- uses full 3-color conditional formatting (not simply setting the two extreme colors the same to look like abs value)
- creates symmetric color ranges by using a obstructed cell (say under a button) to hold the extreme values
- uses statistical analysis to match the color gradients even in skewed data sets
both steps are necessary and neither one on its own is sufficient to create a true mirror color scale
Since this solution requires statistical analysis of the data set, you would need to run it again any time you changed a number (which was actually the case before, I just never said it)
and now the code. Put it in vba or some other highlighting program. It is nearly impossible to read as is ..... takes deep breath
Sub main()
Dim Rng As Range
Dim Cell_under_button As String
Set Rng = Range("A1:H10") 'change me!!!!!!!
Cell_under_button = "A15"
Call AbsoluteValColorBars(Rng, Cell_under_button)
End Sub
Function iGetPercentileFromNumber(my_range As Range, num_to_find As Double)
If (my_range.Count <= 0) Then
Exit Function
End If
Dim dval_arr() As Double
'this is one bigger than the range becasue we will add "num_to_find" to it
ReDim dval_arr(my_range.Count + 1)
Dim icurr_idx As Integer
Dim ipos_num As Integer
icurr_idx = 0
'creates array of all the numbers in your range
For Each cell In my_range
dval_arr(icurr_idx) = cell.Value
icurr_idx = icurr_idx + 1
Next
'adds the number we are searching for to the array
dval_arr(icurr_idx) = num_to_find
'sorts array in descending order
dval_arr = BubbleSrt(dval_arr, False)
'if match_type is 0, MATCH finds an exact match
ipos_exact = Application.Match(CLng(num_to_find), dval_arr, 0)
'there is a runtime error that can crop up when num_to_find isn't formated as long
'so we converted it, if it was a double we may not find an exact match so ipos_Exact
'may fail. now we have to find the closest numbers below or above clong(num_to_find)
'If match_type is -1, MATCH finds the value <= num_to_find
ipos_small = Application.Match(CLng(num_to_find), dval_arr, -1)
If (IsError(ipos_small)) Then
Exit Function
End If
'sorts array in ascending order
dval_arr = BubbleSrt(dval_arr, True)
'now we find the index of our mid color point
'If match_type is 1, MATCH finds the value >= num_to_find
ipos_large = Application.Match(CLng(num_to_find), dval_arr, 1)
If (IsError(ipos_large)) Then
Exit Function
End If
'barring any crazy errors descending order = reverse order (ascending) so
ipos_small = UBound(dval_arr) - ipos_small
'to minimize color error we pick the value closest to num_to_find
If Not (IsError(ipos_exact)) Then
'barring any crazy errors descending order = reverse order (ascending) so
'since the index was WRT descending subtract that from the length to get ascending
ipos_num = UBound(dval_arr) - ipos_exact
Else
If (Abs(dval_arr(ipos_large) - num_to_find) < Abs(dval_arr(ipos_small) - num_to_find)) Then
ipos_num = ipos_large
Else
ipos_num = ipos_small
End If
End If
'gets the percentile as an integer value 0-100
iGetPercentileFromNumber = Round(CDbl(ipos_num) / my_range.Count * 100)
End Function
'fairly well known algorithm doesn't need muxh explanation
Public Function BubbleSrt(ArrayIn, Ascending As Boolean)
Dim SrtTemp As Variant
Dim i As Long
Dim j As Long
If Ascending = True Then
For i = LBound(ArrayIn) To UBound(ArrayIn)
For j = i + 1 To UBound(ArrayIn)
If ArrayIn(i) > ArrayIn(j) Then
SrtTemp = ArrayIn(j)
ArrayIn(j) = ArrayIn(i)
ArrayIn(i) = SrtTemp
End If
Next j
Next i
Else
For i = LBound(ArrayIn) To UBound(ArrayIn)
For j = i + 1 To UBound(ArrayIn)
If ArrayIn(i) < ArrayIn(j) Then
SrtTemp = ArrayIn(j)
ArrayIn(j) = ArrayIn(i)
ArrayIn(i) = SrtTemp
End If
Next j
Next i
End If
BubbleSrt = ArrayIn
End Function
Sub AbsoluteValColorBars(Rng As Range, Cell_under_button As String)
negrange = ""
posrange = ""
'deletes existing rules
Rng.FormatConditions.Delete
'makes a negative and positive range
For Each cell In Rng
If cell.Value < 0 Then
' im certain there is a better way to get the column character
negrange = negrange & Chr(cell.Column + 64) & cell.Row & ","
Else
' im certain there is a better way to get the column character
posrange = posrange & Chr(cell.Column + 64) & cell.Row & ","
End If
Next cell
'removes trailing comma
If Len(negrange) > 0 Then
negrange = Left(negrange, Len(negrange) - 1)
End If
If Len(posrange) > 0 Then
posrange = Left(posrange, Len(posrange) - 1)
End If
'finds the data extrema
most_pos = WorksheetFunction.Max(Range(posrange))
most_neg = WorksheetFunction.Min(Range(negrange))
'initial values
neg_range_percentile = 50
pos_range_percentile = 50
'if the negative range has the most extreme value
If (most_pos + most_neg < 0) Then
'put the corresponding positive number in our obstructed cell
Range(Cell_under_button).Value = -1 * most_neg
'and add it to the positive range, to reskew the data
posrange = posrange & "," & Cell_under_button
'gets the 50th percentile number from neg range and tries to mirror it in pos range
'this should statistically skew the data
the_num = WorksheetFunction.Percentile_Inc(Range(negrange), 0.5)
pos_range_percentile = iGetPercentileFromNumber(Range(posrange), -1 * the_num)
Else
'put the corresponding negative number in our obstructed cell
Range(Cell_under_button).Value = -1 * most_pos
'and add it to the positive range, to reskew the data
negrange = negrange & "," & Cell_under_button
'gets the 50th percentile number from pos range and tries to mirror it in neg range
'this should statistically skew the data
the_num = WorksheetFunction.Percentile_Inc(Range(posrange), 0.5)
neg_range_percentile = iGetPercentileFromNumber(Range(negrange), -1 * the_num)
End If
'low red high green for positive range
Call addColorBar(posrange, False, pos_range_percentile)
'high red low green for negative range
Call addColorBar(negrange, True, neg_range_percentile)
End Sub
Sub addColorBar(my_range, binverted, imidcolorpercentile)
If (binverted) Then
'ai -> array ints
adcolor = Array(8109667, 8711167, 7039480)
' green , yellow , red
Else
adcolor = Array(7039480, 8711167, 8109667)
' red , yellow , greeb
End If
Range(my_range).Select
'these were just found using the record macro feature
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
'assigns a color for the lowest values in the range
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = adcolor(0)
.TintAndShade = 0
End With
'assigns color to... midpoint of range
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = imidcolorpercentile 'originally 50
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = adcolor(1)
.TintAndShade = 0
End With
'assigns colors to highest values in the range
Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = adcolor(2)
.TintAndShade = 0
End With
End Sub
I am going to borrow heavily from the answer of #barryleajo (won't hurt my feelings if you select that answer). As was stated in that answer the order of the conditional formatting is the key, start with the smallest absolute values and work your way up. The difference between that answer and this one is that there is no need to use an "and" statement, since the OP seems to indicate that all values within a certain range of absolute value should receive the same color format. Here is a small example:
I am trying to create a logic function in Excel where I can look at a range of data and if the argument contains text in each cell then the return should be "x", if contains text in 50% of the cells through 75% then "y", if 0% > 50% then "z".
This is my current function:
IF(A4:P4 = "*t*","Complete",IF(A4:P4 = "","Pending","Incomplete"))
Given your comment perhaps try this version:
=LOOKUP(COUNTA(A4:P4)/COLUMNS(A4:P4),{0,50,75,100}/100,{"incomplete","50 to 75","pending","complete"})
that will give incomplete up to 50%, "50 to 75" for 50% up to 75% and pending for 75% and above......except for 100% which wil be complete - adjust as required