Posts by CUCE

Here is is JkBox. I appreciate your your time on this.

Sub Goal_Seek_Start_Element()

Dim i As Integer, Last As Integer
i = 7   'starting row
N = 2 
Last = Range("C2") + i
Application.ScreenUpdating = False

Do While i <= Last - 1
    'Starting Guess
        Range("D" & i) = Range("AA" & i)
    
    Range("E" & i).GoalSeek Goal:=0, ChangingCell:=Range("D" & i)
    

    IterationCount = i - 6
    
    If IterationCount Mod N = 0 Then
        DoEvents
        Application.ScreenUpdating = True
    Else
    End If
    
    Application.ScreenUpdating = False
    
    
    i = i + 1
Loop

Application.ScreenUpdating = True

End Sub

Carim. I understand the 30minute macro is unusual but its not the macro's fault. Its essentially a range of goal seeks and is as simple as macros get. What makes it take so long is the amount of formulas behind the GS iterations (as well as the overall size of the spreadsheet).

I just thought a screenupdating could shave a few minutes off and would be a simple add.

I appreciate the help. I have a loop routine in a large spreadsheet that takes a while to run. Mostly due to the size of the worksheet itself but I'm looking for ways to speed it up, like turning the screenupdating = false. However due to the length of the routine (taking anywhere from 15-30mins), I wanted to create a periodic screenupdate. I've placed it inside an If statement nestled in a loop but its not engaging and I don't know why. I should add that if I add a simple msgbox w/ the screenupdate, it'll work as intended.

Thank you for anyone's time put into trying to help me here.

Sub ScreenUpdate()
Dim i as integer

Application.ScreenUpdating = False
N=10
Do While i < 300

  < Normal Code Routine >

    IterationCount = i

    If IterationCount Mod N = 0 Then
        Application.ScreenUpdating = True
    Else
    End If
    
    Application.ScreenUpdating = False

    i=i+1
Loop

Application.ScreenUpdating = True

End Sub

My apologies royUK. I'll try to keep that in mind next time I post.

Regarding the question, I think I have this figured out and wanted to share if anyone was interested.

In my routine to draw all my shapes, I named them

.Name="Oval"&i
.Name="Freeform"&i

And likewise for any other type as I looped through tables of coordinates & shape sizes. To select and group:

Sub SelectShape()

Dim arrShapeNames() As Variant
Dim shp As Shape
Dim sr As ShapeRange
Dim ws As Worksheet
Dim i As Integer

Set ws = ActiveSheet

ReDim arrShapeNames(ws.Shapes.Count - 1)
i = 0 

For Each shp In ws.Shapes
If Not InStr(shp.Name, "Oval") = 0 Then
arrShapeNames(i) = shp.Name
i = i + 1
End If

If Not InStr(shp.Name, "Freeform") = 0 Then
arrShapeNames(i) = shp.Name
i = i + 1
End If

Next

Set sr = ws.Shapes.Range(arrShapeNames)
Set srGroup = sr.Group
srGroup.Name = "Group Name"

Set sr = Nothing
Set ws = Nothing

End Sub

This grouped all the shapes with the names I had decided on before. And named the group.

To delete, I find the group name:

Set ws = ActiveSheet


For Each shp In ws.Shapes
If shp.Name = "Column_Section" Then
shp.Delete
Else
End If
Next

Thank you to anyone who took time to read my post.

I also apologize for the late response. I thought I had email notifications selected for responses but I was mistaken. I thought my thread was forgotten.

I have a macro that draws anywhere up to 36 shapes, depending on user inputs, all contained in a range of cells called "DrawRange". This works pretty well. However I'm having issue with grouping all these shapes together (so a user can move/manipulate the drawing easily) and deleting this group in a 'redraw' event.

Heres what I have for the group:

Sub GroupShapes()
Dim shp As Shape
Dim r As Range
Set r = Range("DrawRange")
For Each shp In ActiveSheet.Shapes
 If Not Intersect(shp.TopLeftCell, r) Is Nothing Then
 shp.Select Replace:=False
 End If
Next shp
Selection.Group
End Sub

I sometimes get an error "Application-defined or object-defined error" listed for the "If Not Intersect" line. Any ideas what would cause this?

The delete routine is similar except

shp.delete instead of select. Naturally the same issue at the same line

I've thought about naming the grouped drawing. But I wasn't able to figure out how to do that. Thanks in advance.

Thanks for responding baddyswing. I did something very similar to your answer. Not quite as clean and smooth however.

I ended up creating a 1 dimensional sub array for both Array1 and Array2 and then add that together. Not realizing that I could sum them together like you showed.

I really appreciate your response.

I'm still feeling out how to use arrays in my VBA codes and I was hoping someone could help me out with this.

I have two 2dimension arrays with the same count of rows but different columns. I was hoping there was a way to sum up all the rows of the two arrays into a 1 dimension/column array?

Lets say:

ReDim Array1 (1 to 11. 1 to 15)
ReDim Array2 (1 to 11, 1 to 20)
ReDim SumArray (1 to 11, 1)

I'm not sure how I can get SumArray = Array1 + Array2

Thanks in advance.

I apologize for disappearing. I went out of town and couldn't give this attention.

I was attempting to have a userform textbox read and copy the contents of an activecell - that I could modify (in the userform). One of which was to add a number of symbols using command buttons. (I would have more edit buttons but I have that figured out). What I was trying to do was have the symbol command button add the symbol the userform textbox and if it was possible to do so where the cursor points. Rather than the end.

However, I don't think this is doable. Tell me if I'm wrong. But I'm changing the symbol commandbuttons to add the symbol to the end of text existing in activecells. Thank you for your time.

ActiveCell.Value = ActiveCell.Value & ChrW(177)

Also, if I can't reference the userform textbox or even the cursor caret location, which I don't think I can. I'm open to being able to insert this symbol at the end of a text string in an activecell (similar to the insert symbol tool built into excel - except with a much smaller field that I can navigate).

Thanks again

royUK,

I see where my post was confusing. I was referring to the navigation caret, the flashing vertical bar, rather than the actual caret symbol.

The line also doesn't seem to interact with the textbox in the userform - only in the active cell on the spreadsheet. Is there anyway to have the symbol be added inside the userform?

I have a userform that I can enter text into a textbox that will overwrite an active cell. The idea being that I can superscript, subscript and a bunch of other repetitive text edits as I build spreadsheets. However I am wondering how I can change one of my command buttons to enter a symbol into the textbox instead of the active cell.

For example, I want to enter the +/- symbol into a text cell. I can never remember Alt + 241 so this would store it. My current sub is as follows:

Private Sub btnPlus_Minus_Click()
ActiveCell.Formula2R1C1 = ChrW(177)
End Sub

Instead of the active cell, I would like this character to be placed where the caret is on the textbox. Any help is appreciated.

Re: Macro speed issue on long loop

It appears if I remove the "calc" boolean variable and turn calculation back to automatic with "Application.Calculation = xlCalculationAutomatic" then I avoid the OverFlow error. The macro still moves MUCH faster than what I had originally so I am grateful. Thank you for your help.

Re: Macro speed issue on long loop

Derk. That was very fast. I went from 45-50s to 1/2s or so. I have one issue however. I can only seem to run this once. If one of the condition cells change and I need to run it a second time to update the page, I get an "OverFlow" error and it highlights the "Calc = .Calculation" line. Do you know what the debugger is trying to say with this? Thank you again for the help.

I have a macro that is intended to hide rows based on conditions in two cells on each row. If column "B" has a zero or is column "BA" doesn't match a user input, the row should hide. Its being used on several sheets with varying number of rows to loop through but the max is a little over 600 rows. The code I've attached works and does get the job done but it takes more time than I would prefer. I suspect there is a better way than using a "For Each" loop but my macro knowledge is limited at best. Can anyone help me improve the code below?

I appreciate the help anyone can pass along.

Sub HideRows()
    Dim rCell As Range
    Dim FinalRow As Long
    Dim Row As Integer
    Application.ScreenUpdating = False
    FinalRow = Cells(65536, 8).End(xlUp).Row
    For Each rCell In Range(Cells(13, 2), Cells(FinalRow, 2))
            If (rCell = "" Or rCell <> 0) And rCell(1, 52) = Range("BOMTYPE") Then
                rCell.EntireRow.Hidden = False
            Else
                rCell.EntireRow.Hidden = True
            End If
    Next rCell
    Application.ScreenUpdating = True
End Sub

Re: Disable userform textbox

Thank you S O. I tried that first one and it works exactly like I was hoping.

I have a userform add-in used for editing text quickly. A textbox will show the text in an active cell to where I can change to a number of standard formats, change to subscript, superscript, etc. Works pretty good for the times I need it. However, it cannot add anything to the cell in question - I can only modify what is existing. To improve on this tool I tried the following sub:

Private Sub TextBox1_Change()
    ActiveCell = TextBox1.Text
End Sub

This routine has the textbox reading the active cell and overwriting it with the pulled value. With a text only cell, you see no difference. The issue I have is that it will automatically overwrite a cell with an equation with the value only. So if the cell was "=5+5" its now "10" and is no longer a formula. Is there a way to kill this routine if the active cell is an equation? Or when it overwrites the cell, it does so with the formula and not value only?

I appreciate any help you can give.

Re: Update UserForm textbox to new active cell

That worked beautifully. I appreciate you taking the time to help me out on this. Thank you.

Re: Update UserForm textbox to new active cell

I did a little bit of testing with this userform. I changed the textbox sub to the VB code below. When this userform is run, not as an add-in, it works great. However for some reason the add-in part disables the textbox from refreshing. Can anyone give any insight to this? Thank you.

Private WithEvents ws As Excel.Worksheet


Private Sub UserForm_Initialize()
    Set ws = ThisWorkbook.ActiveSheet
End Sub


Private Sub ws_SelectionChange(ByVal Target As Range)
    TextBox1.Text = ActiveCell
End Sub

I am working on a addin UserForm to help quickly format cell text, especially only select characters in a cell. I have this functional in a modal setting working with the active cell when I activate the UserForm. What I would like to be able to do is to work in excel without having to close the Userform and have the textbox update with each new cell. I have changed the UserForm properties to ShowModal = false which gets the first half. However the textbox will only show the cell value I started with. I've added part of my code if it helps.

Thank you

Private Sub UserForm_Activate()
    TextBox1.Text = ActiveCell
End Sub
Private Sub btnSub_Click()
    Dim intStart As Integer
    Dim intLength As Integer
    intLength = TextBox1.SelLength
    If intLength > 0 Then
        intStart = TextBox1.SelStart + 1
        ActiveCell.Characters(intStart, intLength).Font.Subscript = True
    End If
End Sub
Private Sub btnExit_Click()
    Unload UserFormTextEditor
End Sub