Programmatically Position excel ListBox - excel

I need to dynamically create and delete 1 - N number of listboxes on a worksheet. Because the page will be changing I can't know in advance where to place the control so a statement like ... Left:=10, Top:=10, Width:=106.8, Height:=154.6 won't work. I need to be able to programmatically place controls at C1 or C55 for example.
The research I've done found only examples of static creation at a fixed location and I also haven't been able to find anything that will give me the coordinates of a cell (ex: C1 = Left:=65, Top:87).
Thanks for your help.

Consider this:
Dim i&, n&, r As Range
n = 3
With ActiveSheet
For i = 1 To n
Set r = .Range("c1")(i)
.ListBoxes.Add r.Left, r.Top, r.Width, r.Height
Next
End With
This simply demonstrates how to use the dimensions and coordinates of a cell as the dimensions and coordinates of the control. It will be off a bit on height. You can adjust that.
Additionally you can use whatever mechanism you wish to identify the cells. I just did the three top cells of column C.

Related

Auto fill specific cell range with formulas

I have this formula:
IF(ROWS($Q$27:Q27)<=$P$25,INDEX(DataTable[[#All],[Time]],$P27),"")
and if I drag it to the right, it should automatically read each column respectively; example:
=IF(ROWS($Q$27:R27)<=$P$25,INDEX(DataTable[[#All],[Name]],$P27),"")
^Notice that the first Q27 is fixed, the second Q27 is variable.
I drag this formula to the right by 15 columns, and down to 50 rows. that's 750 formulas in total.
I want to do this in vba, but if I did this, it will be 750 lines of code for each cell representing each row/column.
example: .Range("G17").Formula=IF(ROWS($Q$27:R27)<=$P$25,INDEX(DataTable[[#All],[Name]],$P27),"""")
and if I drag it down, it will automatically pick up what I exactly want, example:
=IF(ROWS($Q$27:Q28)<=$P$25,INDEX(DataTable[[#All],[Time]],$P28),"")
so this formula should be written 750 times in total for the cell range [ A27:N76 ]
Any faster / more dynamic approach? and if possible, can I make it depend on more than 50 lines based on a cell value inside the sheet?
Example:
This should do it all in one line:
Range("A27:N76").FormulaR1C1 = "=IF(ROWS(R27C17:RC[16])<=R25C16,INDEX((DataTable[[#All],[Name]],RC16),"""")"
EDIT: Seems a more that one line of code required after all 😊
The code below will do what you want (this time fully tested)
Sub FillFormulas()
Dim inC%, rgHead As Range
''' Assumes the target sheet is Active.
''' o If that's not the case, change this With statement to reference the target sheet
With ActiveSheet
''' Set rgHead to the Table's header row
Set rgHead = .ListObjects("DataTable").Range.Rows(1)
''' Add the formulas to the target range, column by column updating the table header on the fly
With .Range("A27:N76")
For inC = 1 To .Columns.Count
.Columns(inC).FormulaR1C1 = _
"=IF(ROWS(R27C17:RC[16])<=R25C16,INDEX(DataTable[[#All],[" & rgHead.Cells(inC) & "]],RC16),"""")"
Next inC
End With
End With
End Sub
so this formula should be written 750 times in total for the cell range [A27:N76]
You don't need to do that. If you specify range.Formula, it will fill the proper formulas all the way across and down. Just give it the formula of the top/left most cell.
So, in your case
Range("A27:N76").Formula = "=IF(ROWS($Q$27:R27)<=$P$25 ... "
EDIT: This response had some obvious errors
This has an obvious error (as tested part and then merged to the full thing).
Range(A27:N76).FormulaR1C1 = "=IF(ROWS(R27C17:RC[16])<=R25C16,INDEX((DataTable[[#All],[Name]],$P27),"""")"

Select all rows where all cells equal one another

I have a large table that only shows a single type of information: whether or not a species of plant was present at a particular study site. I have 500+ species listed in the first column, and 30 sites as column names. The table is populated with a simple "Y" or "N" to show presence. Example:
Scientific Name Old Wives Beach Dadi Orote N Airstrip
Abelmoschus moschatus N N N
Abrus precatorius Y N Y
Abutilon indicum N N N
However, the species list contains some species that do not occur at any sites, rendering a row full of "N"s, like the 1st and 3rd rows in the example above. I need to delete those rows in order to make the table more manageable.
Is there any way to achieve this without a long IF AND statement?
Inspired by pnuts' comment, in a new column, use the a COUNTIF() formula. For example, =COUNTIF(B2:AE2,"Y"), assuming the row/column headers are in row 1 and column A and the data is in the range B2:AE501+.
If you then select the entire range, including the headers and the new formula column and add filters, then you can select only the rows where the count of Y's is 0. Once you have only the 0's showing, you can select the entire rows and delete them (using Right-Click, Delete) without effecting the non-zero rows.
At this point, if you no longer need the count column, you can turn off the filter and delete the column but I wouldn't be surprised if you find the count comes in handy for some other reason.
Alternately, you could just use the filter to HIDE the 0 rows rather than delete them and that way to don't remove the data altogether but it's no longer in your way.
The code below is one way to do this, assuming there are no gaps in the data. The animated gif steps through to demonstrate how it works. You should remove the .select statements once you understand it.
Sub deleteIfAllN()
Dim plantR As Range, cell As Range, allN As Boolean
Set plantR = Range("A2")
While plantR <> ""
plantR.Select
Set r = plantR.Offset(0, 1)
allN = True
Do
r.Select
If r <> "N" Then
allN = False
Exit Do
End If
Set r = r.Offset(0, 1)
Loop Until r = ""
Set plantR = plantR.Offset(1, 0)
Rows(plantR.row - 1).Select
If allN Then Rows(plantR.row - 1).Delete
Wend
End Sub
You can use the Advanced Filter
Set up your data and criterion area as below
For the example you posted, the formula would be:
=COUNTIF($B8:$D8,"N")<>3
For 30 columns, just modify the range and the count.
Before
After
I chose to filter in place
Note that there is also an option to Copy to another location which would place the results of the filter in another location.

Set the color of one cell based on the color of another cell

What I would like to have is:
IF A1 in Sheet 2 is blue
Then A1 in Sheet 1 changes to blue
I know I can get the color of A1 in Sheet 2 by using:
=GET.CELL(63,Sheet2!A1)
(Excel: Can I create a Conditional Formula based on the Color of a Cell?)
But I can't figure out what I should do in the next step.
Update on 12.01.2015
At the beginning I thought a function would work, but as I considered my file, VBA may be needed.
It is about the output of a correlation analyse from SPSS, there are three columns: correlation coefficient, p-value and sample size.
I need to check the coefficient and p-value at the same time, and present the coefficient in a readable way. Say I run a correlation between 50 variables with 100 variables, I would not paste coefficient and p-value in one sheet, rather:
sheet one : coefficient
sheet two: p-value
What I would to have is:
If value of p-value is bigger than 0.05, then coefficient (cell) changes to blue/dark blue or black.
So that when I watch the first sheet, I know blue ones should be ignored because of non-significance.
What you need is a way to detect changes in cell format.
There appears to be no event that triggers upon change in format. See
How to detect changes in cell format?
I will describe a workaround, almost step-by-step. It is not keystroke-by-keystroke, so you may have to google a bit, depending on you background knowledge.
The description is not short, so please read it through.
You have to:
Detect change in Selection (there is an event for this).
Inquire about the color of your source cell.
Act if needed.
Go to the Visual Basic Editor (VBE) and add code in three modules:
A standard module (say, Module1). You have to first insert the module.
ThisWorkbook.
Sheet2.
In Module1:
Public prev_sel As Range
Public wssrc As Worksheet, wstrg As Worksheet
Public ssrc As String, strg As String
Public rngsrc As Range, rngtrg As Range
Sub copy_color(rngs As Range, rngt As Range)
Dim csrc As Long
csrc = rngs.Interior.Color
If (csrc = vbBlue) Then
rngt.Interior.Color = vbBlue
End If
End Sub
Sub copy_color2(rngs As Range, rngt As Range)
If (TypeName(prev_sel) = "Range") Then
Dim pss As String
pss = prev_sel.Parent.Name
If (pss = ssrc) Then
Dim ints As Range
Set ints = Application.Intersect(rngs, prev_sel)
If (Not (ints Is Nothing)) Then
Call copy_color(rngs, rngt)
End If
End If
End If
End Sub
In ThisWorkbook:
Private Sub Workbook_Open()
ssrc = "Sheet2"
strg = "Sheet1"
Set wssrc = Worksheets(ssrc)
Set wstrg = Worksheets(strg)
Set rngsrc = wssrc.Range("A1")
Set rngtrg = wstrg.Range("A1")
Call copy_color(rngsrc, rngtrg)
If (TypeName(Selection) = "Range") Then
Set prev_sel = Selection
Else
Set prev_sel = Nothing
End If
End Sub
In Sheet2:
Private Sub Worksheet_Deactivate()
Call copy_color(rngsrc, rngtrg)
If (TypeName(Selection) = "Range") Then
Set prev_sel = Selection
Else
Set prev_sel = Nothing
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call copy_color2(rngsrc, rngtrg)
If (TypeName(Target) = "Range") Then
Set prev_sel = Target
End If
End Sub
I will soon edit with explanations. Reading carefully, it can be readily understood, though.
Notes:
This code does not act if the source cell color changes from vbBlue to something else. You did not specify anything for this action. Actually, your specification was not detailed enough to cover all possible cases.
There might be cases (extremely unlikely, I guess) where this code fails. For instance, if color is changed via other VBA code, without selecting/deselecting cells.
The idea is to check for the need of acting after as many relevant events as possible. Here I am detecting Workbook_Open, Worksheet_Deactivate, Worksheet_SelectionChange. You may add other events with suitable Subs, e.g., Workbook_BeforeClose, Workbook_BeforeSave. All this is a way of substituting for the non-existing event of changing cell format.
I like the answer by pnuts (although I did not have time to test it). But the present one gives a flexibility that is not available with the other. There might be some cases (depending on what you need to do) that would not be covered by it.
There are other possible combinations of places to locate variables declaration and other code, essentially performing the same actions.
Not recommended because of reliance on the XLM (not XML) Macro function GET.CELL. This from a technology introduced 30 years ago that was effectively superseded eight years later. With almost all its elements now defunct, the few that remain can be expected to have a low life expectancy. Microsoft encourages migration to VBA.
Nevertheless, you have asked ‘how’ rather than ‘why not’, so I suggest you proceed from where you have reached and select Sheet1 A1 and HOME > Styles - Conditional Formatting - New Rule..., Use a formula to determine which cells to format, Format values where this formula is true:
=CellColor=23
and select blue formatting of your choice, OK, OK, Apply.
23 is a fairly standard number for Blue (not Light, not Dark) but your configuration may expect a different number.
Note that another disadvantage is that, unlike CF in general, the response is not automatic – you may need to enter something in Sheet1 A1, or Shift+F9 to force an update.
If your data is spread across two sheets (Sheet1 and Sheet2, both ColumnA) and there is a 1:1 relationship (the p-value in A1 of Sheet2 is that for the correlation coefficient in A1 of Sheet1) then a simple Conditional Formatting rule may suffice:
Select Sheet1 ColumnA and HOME > Styles - Conditional Formatting, New Rule...
Use a formula to determine which cells to format
Format values where this formula is true:
=Sheet2!A1>0.05
Format..., select dark blue or to suit, OK, OK.
The same rule might be applied in Sheet2 (ColumnA) in the same way so the cells (by row) conditionally formatted in one sheet are those conditionally formatted in the other.
The GET.CELL function, whilst useful, comes from the old XLM macro language which was used before VBA. You may encounter restrictions using this e.g. at that time Excel used a limited number of colours (I have read somewhere around 60?).
Alternatively, with a bit of VBA, you could experiment with the Interior Object and also the Font Object :
Sheets("Sheet1").Range("A1").Interior.Color = vbBlue
Sheets("Sheet1").Range("A1").Font.Color = vbYellow
If Sheets("Sheet1").Range("A1").Interior.Color = vbBlue Then _
Sheets("Sheet2").Range("A1").Interior.Color = vbBlue
If Sheets("Sheet1").Range("A1").Font.Color = vbYellow Then _
Sheets("Sheet2").Range("A1").Font.Color = vbYellow
You will likely need to explore the various ways of specifying the colors to use to give you maximum control/flexibility.
Just to be clear and to keep the functionality you deliver simple, you could use conditional formatting and choose to set the format with a colour. This is incredibly easy once you know how. The main trick is what formula to enter and specifically which cell you need a conditional formats formula to reference when the conditional format applies to a multi cell range.
As an example. If your conditional formatting rule is created such that it applies to the range $C$5:$C$10 the formula you use will often need to be entered as =(A5="A"). Note this is a relative addressing formula ie no dollar signs. this has the effect of the cell c6 inspecting the value of a6 etc.
Your only complication now is to inspect the formatting of the cell rather than the value it stores. In 2013, you can still use =GET.CELL(63,A5) to do this, however this can't be entered in the formula of the CF rule ... Other posts discuss the whys and wherefores of using this. See this link which described how to get cell info.
So you'll end up with a formula in a cell next to the cell that has the colouring. The formula will use a named range that returns true or false depending on whether the colour of the cell matches the colour you specify in the named range. You conditional formatting on another sheet will reference this formula cell and set the colour of the new cell.
You would use the following formula in the named range called "Get .
=GET.CELL(65,OFFSET(INDIRECT("RC",FALSE),0,1))
I've got this to work, and the key information can be found one the referenced web site page.
Ok?

Move to new workbook as values by tab color?

I have a large report with multiple data tables and about 12-20 sheets of broken out reports. What I currently have to do is Move/Copy, all the tabs, and then go through and copy and paste values to drop the pivot references. I've color coded which ones should be grouped together.
I am a VBA novice for sure, but wanted to know if someone could help me out. Is there anyway to reference tab color in VBA? If so could someone provide a quick code that might do this for me.
If a tab has had a color assigned then
Activesheet.Tab.Color
will return the RGB value (as a Long). If no color has been assigned it returns False
I am not sure exactly what you are trying to do but in addition to what Tim said you can access the color of a tab by using the color index, for example:
ActiveSheet.Tab.ColorIndex
This returns a number that matches simple colors.
There is a table that you might find usful for this here:
http://dmcritchie.mvps.org/excel/colors.htm
To loop through your sheets you could write a simple loop such as:
Dim Sheetcount As Integer
Dim i As Integer
Sheetcount = ActiveWorkbook.Worksheets.Count
For i = 1 To Sheetcount
If ActiveWorkbook.Sheets(i).Tab.ColorIndex = 3 Then 'just an example color
'your code here
Next i

Making Excel VB compare cells and then select all rows which contain the same data in a cell and re-format plus chart [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 2 years ago.
Improve this question
Simple question but I simply cannot find an answer. I find searching through the awkward excel visual basic manual with only beginner level knowledge very frustrating. Please help.
I have data from a load of stock trades. They are returned to me in the following format:
https://my.syncplicity.com/share/jjuqll2r00/Screen_Shot_2013-05-20_at_23.02.07
PLEASE CLICK LINK ABOVE FOR IMAGE - AM A BEGINNER WITHOUT REPUTATION TO POST DIRECT :)
Hopefully you can see that there is a column labelled market and then a list of different financial assets e.g. Gold.
I need excel to match all the rows with the same entry under the markets column and then colour the rows the same colour. I want it also to create a new table which has an aggregate of the data for that asset which I will then plot relative to the other assets in a pie chart.
The problem is the number of different assets can be unlimited, so I can't be direct with my codes: i.e.
dim rge as range
rge = activesheet.usedrange.find("Market", lookat:=xlpart)
rwnbr = rge.end(xldown).row
colnbr = rge.column
for i = 1 to rwnbr
if cells(i,colnbr).value = "*Gold*" then cells.(i,colnbr).interior.colorindex = 3
end if
if ..................... = "*Xstrata*" then .......................
end if
next i
The above would be no good since I would have to tell excel which assets should match.
I need to automate it so that it colors the rows differently if they are different assets (and there can be any number of different assets so it would have to choose separate colours for each). I need it to then create a new summary table of the trades for that asset so it will show overall profit/loss and then put it into a pie chart.
This should be easy once I know how to code VBA to operate on a selection of identical (but not initially told) data.
Please please help!
Thank you.
Assuming the data is already sorted by Market column, as per your screenshot, in order to do the color formatting you could do something like:
Sub ColorMyTable()
Dim rng as range 'column range
Dim r as Long 'row iterator
Set rng = Activesheet.Range("E2",Range("E2").End(xlDown))
'## Assign some color to the last cell in this column
rng.Cells(1).Interior.ColorIndex = 39
For r = rng.Rows.Count to 1 Step - 1
With rng.Cells(r)
'Check to see if the cell is the same value as the one beneath it
If .Value = .Offset(1, 0).Value Then
'## Make them the same color
.Offset(1,0).Interior.ColorIndex = .Interior.ColorIndex
'
Else:
'## Code to apply a new semi-random color to the next row
' , when the values don't match.
.Offset(1, 0).Interior.ColorIndex = .Offset(1,0).Row Mod 55
End If
End With
Next
End Sub
This is the easiest, and also probably the ugliest, way I can think of to assign colors without any assignment in advance.
There is no check to see if the color has already been used, but I think this should come up with 55 different colors for you.
Unfortunately, unless you have some idea of what colors to use in advance, I can't think of a really easy way to assign colors. But here are a few more complicated methods you might try to adapt:
You could for instance use a single color's long value, and then apply a particular .TintAndShade factor based on how many unique Asset's there are in the column. Like, this: How to assign gradient colors to an excel column?
On a similar note, you could assign a few colors as public variables, or use the built in constants from the color Theme (assuming Excel 2007+) and use a VBA function to rotate through these colors, also applying .TintAndShade, if necessary, just like the above, but with a bit more tweakability to use multiple colors.
You could use a random number generator to assign the color values, storing used colors in a collection, and checking for duplicate colors (and forcing a new color, if needed), etc.
Code that fails with naming range:
Dim ran9e As Range
Set ran9e = ActiveSheet.UsedRange
Range("A1").Select
Sheets.Add.Name = "Summary"
ActiveWorkbook.PivotCaches.Create(xlDatabase, ran9e, xlPivotTableVersion14).CreatePivotTable tabledestination:=Sheets("Summary"), _
tablename:="PivotTable1", defaultversion:=xlPivotTableVersion14
Sheets("Summary").Select
Cells(3, 1).Select

Resources