Excel VBA Changing text inside shapes based off a range of cells - vba

I have made a large diagram of made by shapes with numbers stored inside as text and need to change the "old" numbers to a "new" range of numbers. On each of the 20 sheets there are circles, Rectangles, Left Arrows and Right Arrows. The old range of numbers are stored on a separate spreadsheet in the Column "A" and need to be changed to the numbers listed in Column "B" (as in A1 to B1).
What would a VBA method to change the old text inside the Shapes to the new correct text based off of a new range of numbers? Is it possible to write a script that changes the values in the entire WorkBook?
My incorrect way of thinking is to:
1. Search inside the diagram to find the various shapes.
2. Get the text inside each shape.
3. Compare the text with the spreadsheet with the old numbers.
4. Insert the new number.
5. Move onto the next shape.

Put a value in A1 and say we already have a Shape:
Running this:
Sub LinkCellToShape()
Dim sh As Shape
Set sh = ActiveSheet.Shapes(1)
sh.DrawingObject.Formula = "=A1"
End Sub
will link the text in the shape to the value in the cell. You could also use:
sh.OLEFormat.Object.formula = "=A1"

Related

Blank cells in matrix take on average of surrounding cells in Excel

I have a matrix of numbers in excel that contains several blank cells. The numbers correspond to the clay level in the ground, as indicated by a borehole in that position. I am using the cells as a grid to represent a map. I want to replace the blank cells with an average of all of the cells which surround it. How do I do this? I keep getting circular reference errors when I try to do it.
1) Use a proxy range: Create a duplicate range and have that refer to the original. The named range here is F5:H6
For above the range on the left (F5:H6) is called namedRange and the blank cell in the duplicate range on the right uses Average(namedRange) to populate the value.
To add a named range , select your range and then add the name via the name manager .
OR
2) Use VBA
With VBA using the same named range (code in a standard module - replace activesheet with your sheetname) :
Option Explicit
Sub test()
With ActiveSheet.Range("namedRange")
.SpecialCells(xlCellTypeBlanks) = Application.WorksheetFunction.Average(.Value)
End With
End Sub

(Excel VBA) - Draw from cell text in a macro

I'm trying to build a small macro that allows the user to format multiple different documents at once.
I would like for the user to be able to enter into a particular cell within the document containing the macro a particular piece of text.
I then want for this piece of text to be able to be drawn upon in the macro while affecting a different document.
For instance, a code to add another column might say
Worksheets(1).Range("A1").EntireColumn.Insert
Instead of specifying the column (A), I would like it to draw on a value in the host document. For instance, the user types "G" into the particular cell, and then clicks a button to run the macro, and the macro will dynamically know to affect column G in all excel documents it targets based off of the value in the host document.
I hope this makes sense.
Any suggestions for the sort of functions I should be looking at to make this work?
"Any suggestions on the sort of functions I should be looking at?"
Here's a few...
To get the value which is entered...
If the cell will always be in the same address, say A1:
' Define a string variable and set it equal to value in A1
Dim cellText as String
cellText = ThisWorkbook.ActiveSheet.Range("A1").Value
or instead of using Range you can also use Cells which takes a row and column number.
cellText = ThisWorkbook.ActiveSheet.Cells(1, 1).Value
If the cell changes then you may need to look into the Find function to look for a label/heading next to the input cell. Then you can use it (easily with Cells) to reference the input...
Once you have this variable, you can do what you like with it.
To put this value into cell B3 in another (open) workbook named "MyWorkbook", and a sheet named "MySheet" you can do:
Application.Workbooks("MyWorkbook").Sheets("MySheet").Range("B3").Value = cellText
To insert a column at cellText, do
Application.Workbooks("MyWorkbook").Sheets("MySheet").Range(cellText & "1").EntireColumn.Insert
Notably here, the & concatonates the strings together, so if
cellText="B"
then
cellText & "1" = "B1"
Further to your comment about moving values between sheets, see my first example here, but always refer to the same workbook. If you find yourself repeatedly typing something like
ThisWorkbook.Sheets("MySheet").<other stuff>
then you can use the With shorthand.
With ThisWorkbook.Sheets("MySheet")
' Starting anything with a dot "." now assumes the with statement first
.Range("A1").Value = .Range("A2").Value
.Range("B1").Value = .Range("B2").Value
End With
Important to note is that this code has no data validation to check the cell's value before using it! Simply trying to insert a column based on a value which could be anything is sure to make the macro crash within its first real world use!

VBA for changing font and colour of a cell if a certain word is typed in it

I have a somewhat large spreadsheet with a type of summary page that follows a calender layout.
On this page I manually change the font and color of cells to make it easy for me to find certain things on it. For example, (I lecture mathematics) if I have revision on a certain lesson, I make that cell bold and green. (exact type of green I can sort out myself). I want a VBA code if possible so that if I type the word revision into a cell on that sheet only, not whole workbook, that it would automatically change it to green.
Realistically, I don't manually type in the word revision always. Some of it uses lookups of various types to find what happens on that day to display a word (for example revision) in that given cell.
I don't know if this is possible to do. I realize that if "revision" is shown due to a lookup then the contents of that cell is not equal to "revision" but a formula which simply displays "revision"
Any assistance would be appreciated. If I have a basic code I can manipulate to get it right.
Thanks
Maybe you're looking for something along the lines of:
Sub CheckRevision()
Dim CurCell As Object
For Each CurCell In ActiveWorkbook.ActiveSheet.Range("A1:AZ500")
If CurCell.Value = "Revision" Then CurCell.Interior.Color = RGB(0,204,0)
Next
End Sub
Or equivalently, you can probably use conditional formatting. Home Tab > Conditional Formatting > Highlight Cells Rules > Text that Contains. From there, type the value "Revision" into the value box and you can change the format of the cell to how you like it.

Excel VBA how to select all cells in a dynamic range were the colour index is not 0

I have a SAP Report embedded in a worksheet, it is refreshed via a macro using variables defined in another worksheet. That all works fine, but i am having trouble selecting the data the report generates.
The headings of the report are in and always will fall in this range ("A17:K17"), but the results rows will vary making the total range I want to capture anywhere from ("A17:K18") to (A17:K1000").
The solutions I've already tried didn't work i think because there is almost no consistency in the result data, it's a mixture of text and numbers with empty cells all over the place, in both the rows and columns. Including the occasional completely empty row. This means the methods I have tried before reach a point where it thinks it's reached the end of the populated rows - but it hasn't.
The only factor that remains the same throughout the report is that the cells in the range I want to capture are all filled with a color as default and anything outside the range is unfilled.
To me the simplest solution would be to use VBA to select all the cells beneath and including the headers on ("A17:K17") where the color index is not 0 (blank?) regardless of their contents as I don't mind capturing empty cells. Except I don't know how to do this.
At this point I'd just like to select this range I haven't decided if I'm going to copy it into a new workbook or into an email yet, but that I can do. I've just hit a dead end selecting it.
Quite unsure exactly what it is you require but here's a solution. It's worth noting that both the ColorIndex and Color properties are not necessarily zero with no fill, so if you just change blankCell to a cell with the fill which you define to be blank you'll be good to go.
Sub test()
Set blankCell = Range("A1") ' change this to a cell that you define to be blank
blankIndex = blankCell.Interior.Color
Set cellsDesired = Range("A17:K17")
For Each cell In Range("A17:K1000")
If cell.Interior.Color <> blankIndex Then
Set cellsDesired = Application.Union(cellsDesired, Range(cell.Address))
End If
Next cell
cellsDesired.Select
End Sub

change font within a shape ppt

I'm automatically generating a powerpoint slide through VBA, User Forms, and Excel. You run the VBA script in excel, fill out the data, the data goes into cells in excel, then the VBA script pulls the data and puts it into textbox shapes in the slide.
My problem is I want to use different font sizes at different times, so for example 28 pt font for one part and 14 pt for the rest. The problem is that any property changes I make to the textbox applies to all of the text within the shape.
My current workaround is sloppy and is to just generate another textbox over the original and insert spacing in the original so it looks like the larger text is "in" the textbox while it's actually just sitting over a few empty lines set aside.
You can format specific substrings within a string, but it's very cumbersome, for example assuming shp is an object variable representing your textbox:
Sub foo()
Dim shp As Shape
Set shp = ActivePresentation.Slides(1).Shapes("TextBox 3")
shp.TextFrame.TextRange.Text = "Hello, world!"
shp.TextFrame.TextRange.Characters.Font.Size = 14 'applies uniform font to entire shape
shp.TextFrame.TextRange.Characters(1, 5).Characters.Font.Size = 28
End Sub
Example output:
The difficulty of course is working with mixed formats, and I do not think there is any easy solution. It will be up to you to determine what formats you need to "capture", and what subsequently implement the appropriate conditional logic to transfer those formats to the PowerPoint shapes.
One possible alternative -- and this is the route that I would go if I were you -- would be to copy the cell from Excel, and use this method to paste in to PowerPoint. I believe this will create a table consisting of a single cell, in the PowerPoint slide. You will have to make adjustments for size/position, but this should be an order of magnitude easier than trying to capture every possible variation of font formatting:
Sub foo2()
Dim shp As Shape
Dim xl As Object
'Get Excel and copy a specific cell
Set xl = GetObject(, "Excel.Application")
xl.Workbooks("Book35").Sheets("Sheet2").Range("B4").Copy
'Paste that cell in to PowerPoint as a table, preserving formats:
ActivePresentation.Slides(1).Select
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
End Sub
Example output, as copied from the Excel cell:
No need to change the font in excel to reflect in Word. You can do it directly. Just paste the below mentinoed line in Word VBA : -
Activedocument.Shapes("sam").TextFrame.TextRange.Words(1).Font.Size = 28