I am working on code that uses Excel buttons to run code. The purpose of this code is to insert a formatted line so that a technical can fill out data values as needed. This way the technician can keep adding as many lines as need.
For one of the test that the technician is performing I want the value to be conditional formatted grey if it is below a certain threshold. The issue with this is that because I keep inserting cell lines into excel I can not reference the same location. I placed buttons to insert these lines and I am using the button location as a reference. Is there any way to use FormulaR1C1 or a different method to make this happen?
My code looks like this:
Private Sub CommandButton2_Click()
Dim V_Val As Variant ' Make the voltage value a variable
Dim rs As Integer ' The push button location
Dim cs As Integer
V_Val = InputBox("Voltage Above") ' Ask user input
rs = ActiveSheet.Shapes("CommandButton2").TopLeftCell.Row ' Get push button location
cs = ActiveSheet.Shapes("CommandButton2").TopLeftCell.Column
Worksheets("Format3").Rows("7:7").Copy 'Always grab from the same location
Worksheets("Meas_sum").Rows(rs).Insert Shift:=xlDown
ActiveSheet.Cells(rs, cs + 1).Select ' Place the voltage value in
Selection.NumberFormat = "#"
Selection.Value = V_Val
' Sig Pulse Grey out code
Range(Cells(rs, cs + 16), Cells(rs, cs + 29)).Select
Selection.FormatConditions.Add Type:=xlExpression, _
ActiveSheet.Cells(r2 + 2, c2 + i).FormulaR1C1 = "=R[-1]C/R[-2]C"
'Formula1:="=G6*1.5>Q6" 'Make above work from refference value
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.499984740745262
End With
Related
I'm working on a excel document being generated with APACHE POI.
The document is filled with many drop down lists for data validation.
The data chosen in those drop down lists are always of the same type:
LABEL (ID)
For the person who fills the excel document, the ID is less important than the LABEL _ but the ID is still necessary for parsing purposes.
I managed through APACHE POI to put a specific format on those kind of cells, in order to help the user to focus on the information more useful to him/her :
LABEL is in black
(ID) is in grey
My problem: when the user change a value in the cell throught the drop down list, the style format is lost on the cell.
My question: is it possible to set up a listener on my excel document that does the folowing job:
on ANY cell
filled through ANY drop down list
on ANY sheet of the workbook
set the specified cell format ?
I already have a function that does the "style format" job, but I don't know how to plug it on this kind of listener...
Function formatStyle()
Dim cellContent As String
Dim valeurLength As Integer
For Each currentCell In Selection.Cells
cellContent = currentCell.Value
For valeurLength = 1 To Len(cellContent)
If Mid(cellContent, valeurLength, 1) = "(" Then
Exit For
End If
Next valeurLength
With currentCell.Characters(Start:=1, Length:=valeurLength - 1).Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With currentCell.Characters(Start:=valeurLength, Length:=Len(cellContent) - valeurLength + 1).Font
.ThemeColor = xlThemeColorDark1
.Color = -4144960
End With
Next
End Function
Excel Form controls don't support any kind of font and color formatting. ActiveX controls let you change the font and colors, but not of individual characters. Custom drawing parts of the control most likely can be achieved with some complicated VBA and WinAPI calls.
The closest alternative I can think of is some of the bold extended Unicode characters:
Thanks to Determine if cell contains data validation, I've managed to do exactly what I wanted:
Private Sub Workbook_SheetChange(ByVal Sh As Object,ByVal Target As Range)
Dim cell As Range, v As Long
For Each cell In Selection.Cells
v = 0
On Error Resume Next
v = cell.SpecialCells(xlCellTypeSameValidation).Count
On Error GoTo 0
If v <> 0 Then
formatReferenceCell (Target)
End If
Next
End Sub
Function formatReferenceCell(cellContent)
Dim X As Integer
For X = 1 To Len(cellContent)
If Mid(cellContent, X, 1) = "(" Then
Exit For
End If
Next X
With ActiveCell.Characters(Start:=1, Length:=X - 1).Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With ActiveCell.Characters(Start:=X, Length:=Len(cellContent) - X + 1).Font
.ThemeColor = xlThemeColorDark1
.Color = -4144960
End With
End Function
I have a macro that inserts 2 columns on my current sheet and pastes information from another sheet.
I want to create 2 variables that are assigned to each column that would change the next time I run the macro to paste the information in the next two columns.
Columns("BO:BO").Select
Selection.Insert Shift:=xlToRight
Range("BO2").Select
ActiveCell.FormulaR1C1 = "Feb weekly-wk 2"
Range("BO19").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(Comparison!RC2,'Jan16 wk4'!R3C15:R34C24,9,FALSE)"
Range("BO19").Select
Selection.AutoFill Destination:=Range("BO19:BO47"), Type:=xlFillDefault
Range("BO19:BO47").Select
Columns("BP:BP").Select
Selection.Insert Shift:=xlToRight
Range("BP2").Select
Selection.Style = "20% - Accent6"
Range("BP2").Select
ActiveCell.FormulaR1C1 = "Diff"
Range("BP19").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
My idea is to set up a variable that I would replace my current "BO" and "BP" code with.
Dim X as String, Y as String
X = "BO"
y = "BP"
When I run the macro it would change the variable for this example "BO" to "BQ" and "BP" to "BR". Next time I run the macro would change the "BQ" to "BS" and "BR" to "BT".
I just cleaned your code a little:
Dim ColBO As Integer
Dim ColBP As Integer
Dim StrBO As String
Dim StrBP As String
StrBO = "BO"
StrBP = "BP"
ColBO = ActiveWorkbook.Range(StrBO & 1).Column 'instead of StrBO you could directly write ("BO" & 1)
ColBP = ActiveWorkbook.Range(StrBP & 1).Column 'Then you wouldnt need these two variables
Columns(ColBO).Insert Shift:=xlToRight
'Columns(ColBO).Select ' Trying to avoid selection but not sure if this works here...
'Selection.Insert Shift:=xlToRight
Range(1, ColBO).FormulaR1C1 = "Feb weekly-wk 2"
Range(19, ColBO).FormulaR1C1 = "=VLOOKUP(Comparison!RC2,'Jan16 wk4'!R3C15:R34C24,9,FALSE)"
Range(19, ColBO).AutoFill Destination:=Range("BO19:BO47"), Type:=xlFillDefault
Columns(ColBP).Insert Shift:=xlToRight 'Same here as above
Range(2, ColBP).Style = "20% - Accent6"
Range(2, ColBP).FormulaR1C1 = "Diff"
Range(19, ColBP).FormulaR1C1 = "=RC[-2]-RC[-1]"
For the future: If you can, try to avoid .Select/Selection/.Activate if possible. The code can mostly run without such commands and without activating a cell. ;)
If you are not actually writing BO/BP to the range you are transforming I would go with two ints, stored in a hidden sheet. Read/write each time you run the macro.
This is, in my opinion, the easier solution, other places to go would be global variables or storing it to a file.
If you want to use numeric variables you can change approach and use Cells instead of Range:
'You can use the rows below to know the column number
Range("BO1").Activate
ActiveCell.Value = ActiveCell.Column 'This way you get the column number into the cell
ColNum = ActiveCell.Column 'This way you get the column number into the variable
'So now you know that BO column number is 67 and you can use
Cells(1, 67) = "OK"
'Or, using variables:
RowNum = 1
ColNum = 67
Cells(RowNum, ColNum) = "You Got It!"
This makes you able to loop columns simply using a for ... next
If you need to loop from BO to BR you can use
For ColNum = 67 To 70
Cells(1, ColNum) = "OK"
Next ColNum
Hope it helps.
This might be a trivial question for you experts out there:
Based on the input (Week) the table is initially filtered on that specific week(WK) and the next one(WK+1).
I'm then formatting all WK+1 cells to be greyed out.
So far so good. Now the question. How can I change the code below so that the entire row containing a cell with the WK+1 value to be greyed out?
ActiveSheet.Range("B5").AutoFilter Field:=1, Criteria1:=WK, Operator:=xlOr, _
Criteria2:=(WK + 1)
With ActiveSheet.Range("$B:$B").FormatConditions _
.Add(xlCellValue, xlEqual, "=" & WK + 1)
With .Font
.Bold = True
.ColorIndex = 15
End With
End With
Thanks in advance!
Mac
This is possible with FormatCondition of type xlExpression.
Example:
ActiveSheet.Range("$A:$Z").FormatConditions.Delete
ActiveSheet.Range("A1").Activate
With ActiveSheet.Range("$A:$Z").FormatConditions _
.Add(Type:=xlExpression, Formula1:="=($B1=" & WK + 1 & ")")
With .Font
.Bold = True
.ColorIndex = 15
End With
End With
I delete the FormatConditions before I add the new one. Because if not, multiple calls of this code would result in multiple FormatConditions ever with the same condition but possible other values of WK. This is because the code adds a new FormatCondition everytime it runs.
Greetings
Axel
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub
I'm graphing a set of data that has blanks in some cells. In the blank cells I have formulas and I have to keep the formulas. When I graph the data, the blank cells are graphed as zeros. I'd like to put gaps instead of zeros in the graph.
I tried right click on the graph > Select Data > Hidden and Empty Cells Settings > Show empty cells as Gaps. But this did not help!
Instead of putting zeros or empty strings try to put #N/A.
You can do it with a formula like =IF([test],[value],NA()).
This will allow the graph not to show the missing values as zeros, but if I understand your question, it is still not what you want, because you want the missing values to be represented as gaps, not as missing values.
The only way that I know of to see the gaps is to use a scattered graph.
As far as I know, all the graphs that make a line to join two points, do join two points, and don't have the concept of missing point. They just join the two closest points.
A solution could be to make a VBA macro that goes inside the graph and changes the color of each graph line when the data is missing.
A solution could be to make a VBA macro that goes inside the graph and changes the color of each graph line when the data is missing.
I have code, that modifies charts.
It works for cells with #N/A, also na() function. Like old excel did.
First, you need a module with public sub:
Public Sub FormatNA()
Dim myChart As ChartObject
Dim series_i As Integer, series_count As Integer
Dim values_i As Integer, values_count As Integer
Dim rows As Integer, r As Integer
Dim mySeries As Object
Dim myValues As Variant
Dim myPoint As Object
Application.ScreenUpdating = False
If ActiveSheet.ChartObjects.Count = 0 Then Exit Sub
' for each chart in active sheet
For Each myChart In ActiveSheet.ChartObjects
' Determine Chart Type
Select Case myChart.Chart.ChartType
Case xlLine, _
xlLineMarkers, _
xlLineMarkersStacked, _
xlLineMarkersStacked100, _
xlLineStacked, _
xlLineStacked100, _
xlXYScatter, _
xlXYScatterLines, _
xlXYScatterLinesNoMarkers, _
xlXYScatterSmooth, _
xlXYScatterSmoothNoMarkers
' for each series
series_count = myChart.Chart.SeriesCollection.Count
For series_i = 1 To series_count
' for each data
Set mySeries = myChart.Chart.SeriesCollection(series_i)
Set myPoint = mySeries.Points(1)
myValues = mySeries.Values
values_count = UBound(myValues)
' global formatting:
Select Case mySeries.ChartType
' MARKERS:
Case xlLineMarkers, _
xlLineMarkersStacked, _
xlLineMarkersStacked100, _
xlXYScatter, _
xlXYScatterLines, _
xlXYScatterSmooth
With mySeries
.MarkerForegroundColorIndex = myPoint.MarkerForegroundColorIndex
.MarkerForegroundColor = myPoint.MarkerForegroundColor
.MarkerBackgroundColorIndex = myPoint.MarkerBackgroundColorIndex
.MarkerBackgroundColor = myPoint.MarkerBackgroundColor
.MarkerForegroundColor = myPoint.MarkerForegroundColor
.MarkerSize = myPoint.MarkerSize
.MarkerStyle = myPoint.MarkerStyle
End With
' NO MARKERS, JUST LINE:
Case Else
End Select
With mySeries
.Border.Color = myPoint.Border.Color
.Border.Weight = myPoint.Border.Weight
With .Format.Line
.ForeColor.RGB = myPoint.Format.Line.ForeColor.RGB
.BackColor.RGB = myPoint.Format.Line.BackColor.RGB
.Weight = myPoint.Format.Line.Weight
.Visible = msoTrue
End With
End With
For values_i = 2 To values_count
' set line invisible if #NA
If IsEmpty(myValues(values_i - 1)) And Not IsEmpty(myValues(values_i)) Then
mySeries.Points(values_i).Format.Line.Visible = msoFalse
'mySeries.Points(values_i).Border.Color = RGB(255, 255, 255) ' for debugging
'mySeries.Points(values_i).Border.Weight = 1
End If
Next values_i
Next series_i
Case Else
' different chart type
End Select
Next
Application.ScreenUpdating = True
End Sub
Then, you'll have to trigger this sub everytime you calculate worksheet:
In ThisWorkbook define sub:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Static Calculated As Boolean
If Not Calculated Then
Call FormatNA
Calculated = True
Else
Calculated = False
End If
End Sub
Maybe it's not perfect, but it works for me. Sample of manipulated chart
May be it might be Usefull any one how has this problem,
Step1: First get Chartpage access and use Display blank as
Excel.Chart chartPage = myChart.Chart;
chartPage.DisplayBlanksAs = Excel.XlDisplayBlanksAs.xlInterpolated;
Happy Coding.
As stenci said, it's difficult to create a gap without VBA due to the presence of formulas in the cells. A time consuming solution is to delete the formulas, which provided blank cells, one by one so that they will then graph as gaps.
For a large dataset that might be too time consuming.
There's a workaround if you're willing to open and close the file:
Set the blank cell to appear empty. For example: =IF(COUNT(A1)>0,A1,"");
Save a copy of your workbook in your preferred format because the next step will eliminate the formulas;
Save the workbook as a .CSV file with a different file name;
Close the file. Then reopen the file;
Now a line graph will provide gaps for the empty cells.
Note that both sides of the gap need to have a line segment, i.e. at least two data cells on both sides of the gap. Specifically, this will graph a gap:
A1=1, A2=2, A3=(blank), A4=4, A5=5.
And this will not graph a gap:
A1=1, A2=(blank), A3=3, A4=4.