Need help modifying VBA code please?

JBShandrew

Board Regular
Joined
Apr 17, 2011
Messages
54
Hi VBA experts. The code below was found on Microsoft's website under VBA for 2003. It is working just fine in Excel 2007. The only thing I would like to change is to have this code execute based on a cell value. For Example I would like the macro to execute one time when a value is placed H2, and not execute again until the value in H2 is changed.

This is a very quick way to get prime numbers for a given number, and is much better than using my calculator to do the division over and over.

Thank you in advance.

Code:
Sub GetFactors()
Dim Count As Integer
Dim NumToFactor As Single 'Integer limits to < 32768
Dim Factor As Single
Dim y As Single
Dim IntCheck As Single
Count = 0
Do
NumToFactor = _
Application.InputBox(Prompt:="Type integer", Type:=1)
'Force entry of integers greater than 0.
IntCheck = NumToFactor - Int(NumToFactor)
If NumToFactor = 0 Then
Exit Sub
'Cancel is 0 -- allow Cancel.
ElseIf NumToFactor < 1 Then
MsgBox "Please enter an integer greater than zero."
ElseIf IntCheck > 0 Then
MsgBox "Please enter an integer -- no decimals."
End If
'Loop until entry of integer greater than 0.
Loop While NumToFactor <= 0 Or IntCheck > 0
For y = 1 To NumToFactor
'Put message in status bar indicating the integer being checked.
Application.StatusBar = "Checking " & y
Factor = NumToFactor Mod y
'Determine if the result of division with Mod is without _
remainder and thus a "factor".
If Factor = 0 Then
'Enter the factor into a column starting with the active cell.
ActiveCell.Offset(Count, 0).Value = y
'Increase the amount to offset for next value.
Count = Count + 1
End If
Next
'Restore Status Bar.
Application.StatusBar = "Ready"
End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
I'd wrap it in a change event:

<font face=Calibri><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#007F00">'   Code goes in the Worksheet specific module</SPAN><br>        <SPAN style="color:#00007F">Dim</SPAN> Count <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br>        <SPAN style="color:#00007F">Dim</SPAN> NumToFactor <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN> <SPAN style="color:#007F00">'Integer limits to < 32768</SPAN><br>        <SPAN style="color:#00007F">Dim</SPAN> Factor <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN><br>        <SPAN style="color:#00007F">Dim</SPAN> y <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN><br>        <SPAN style="color:#00007F">Dim</SPAN> IntCheck <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN><br>        Count = 0<br>        <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#007F00">'   Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> rng = Target.Parent.Range("H2")<br>        <SPAN style="color:#007F00">'   Only look at single cell changes</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>        <SPAN style="color:#007F00">'   Only look at that range</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> Intersect(Target, rng) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>        <br>        <SPAN style="color:#007F00">'   Action if Condition(s) are met (do your thing here...)</SPAN><br>            <SPAN style="color:#00007F">Do</SPAN><br>                NumToFactor = Target.Value<br>                <SPAN style="color:#007F00">'Force entry of integers greater than 0.</SPAN><br>                IntCheck = NumToFactor - Int(NumToFactor)<br>                    <SPAN style="color:#00007F">If</SPAN> NumToFactor = 0 <SPAN style="color:#00007F">Then</SPAN><br>                        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>                        <SPAN style="color:#007F00">'Cancel is 0 -- allow Cancel.</SPAN><br>                    <SPAN style="color:#00007F">ElseIf</SPAN> NumToFactor < 1 <SPAN style="color:#00007F">Then</SPAN><br>                        MsgBox "Please enter an integer greater than zero."<br>                            <SPAN style="color:#00007F">With</SPAN> Target<br>                                .Select<br>                                .Value = ""<br>                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>                        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>                    <SPAN style="color:#00007F">ElseIf</SPAN> IntCheck > 0 <SPAN style="color:#00007F">Then</SPAN><br>                        MsgBox "Please enter an integer -- no decimals."<br>                            <SPAN style="color:#00007F">With</SPAN> Target<br>                                .Select<br>                                .Value = ""<br>                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>                            <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#007F00">'Loop until entry of integer greater than 0.</SPAN><br>            <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> Num<SPAN style="color:#00007F">To</SPAN>Factor <= 0 <SPAN style="color:#00007F">Or</SPAN> IntCheck > 0<br>                            <br>            <SPAN style="color:#00007F">For</SPAN> y = 1 To NumToFactor<br>                <SPAN style="color:#007F00">'Put message in status bar indicating the integer being checked.</SPAN><br>        Application.StatusBar = "Checking " & y<br>                Factor = NumToFactor Mod y<br>                <SPAN style="color:#007F00">'Determine if the result of division with Mod is without _<br>                remainder and thus a "factor".</SPAN><br>                    <SPAN style="color:#00007F">If</SPAN> Factor = 0 <SPAN style="color:#00007F">Then</SPAN><br>                        <SPAN style="color:#007F00">'Enter the factor into a column starting with the active cell.</SPAN><br>                        ActiveCell.Offset(Count, 0).Value = y<br>                        <SPAN style="color:#007F00">'Increase the amount to offset for next value.</SPAN><br>                        Count = Count + 1<br>                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>                <SPAN style="color:#00007F">Next</SPAN><br>        <SPAN style="color:#007F00">'Restore Status Bar.</SPAN><br>        Application.StatusBar = "Ready"<br>        <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

I added a little bit of error handling, but only tested it minimally, so you might want to adjust it a bit.

HTH,
 
Upvote 0
Code should disable/enable event procedures, and clear previous factors before entering new ones.
 
Upvote 0
I'd wrap it in a change event:

Private Sub Worksheet_Change(ByVal Target As Range)
' Code goes in the Worksheet specific module
Dim Count As Integer
Dim NumToFactor As Single 'Integer limits to < 32768
Dim Factor As Single
Dim y As Single
Dim IntCheck As Single
Count = 0
Dim rng As Range

' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
Set rng = Target.Parent.Range("H2")
' Only look at single cell changes
If Target.Count > 1 Then Exit Sub
' Only look at that range
If Intersect(Target, rng) Is Nothing Then Exit Sub

' Action if Condition(s) are met (do your thing here...)
Do
NumToFactor = Target.Value
'Force entry of integers greater than 0.
IntCheck = NumToFactor - Int(NumToFactor)
If NumToFactor = 0 Then
Exit Sub
'Cancel is 0 -- allow Cancel.
ElseIf NumToFactor < 1 Then
MsgBox "Please enter an integer greater than zero."
With Target
.Select
.Value = ""
End With
Exit Sub
ElseIf IntCheck > 0 Then
MsgBox "Please enter an integer -- no decimals."
With Target
.Select
.Value = ""
End With
Exit Sub
End If
'Loop until entry of integer greater than 0.
Loop While NumToFactor <= 0 Or IntCheck > 0

For y = 1 To NumToFactor
'Put message in status bar indicating the integer being checked.
Application.StatusBar = "Checking " & y
Factor = NumToFactor Mod y
'Determine if the result of division with Mod is without _
remainder and thus a "factor".

If Factor = 0 Then
'Enter the factor into a column starting with the active cell.
ActiveCell.Offset(Count, 0).Value = y
'Increase the amount to offset for next value.
Count = Count + 1
End If
Next
'Restore Status Bar.
Application.StatusBar = "Ready"

End Sub


I added a little bit of error handling, but only tested it minimally, so you might want to adjust it a bit.

HTH,


Thank you Smitty it works great. I tried to do one thing and that is clear the colomun from H3 down, before it factors the next number I put in the cell. I have managed to clear the column, but it is not allowing the number to be factored.

This is what I know, but do not know how to use it with conditions.

Code:
[/SIZE][/FONT]
Private Sub Worksheet_Change(ByVal Target As Range)
'Range("H3:H99").Clear
    '   Code goes in the Worksheet specific module
        Dim Count As Integer
        Dim NumToFactor As Single 'Integer limits to < 32768
        Dim Factor As Single
        Dim y As Single
        Dim IntCheck As Single
        Count = 0
        Dim rng As Range
 
Upvote 0
"I tried to do one thing and that is clear the colomun from H3 down, before it factors the next number I put in the cell. I have managed to clear the column, but it is not allowing the number to be factored"

As mentioned in my post, amend the code to disable event procedures at the start and enable them at the end.

 
Upvote 0
What Boller's talking about is using Application.EnableEvents = False at the beginning of the code, and setting it true to the end. As for clearing H3:H99 put that before your Do line, right after EnableEvents.
 
Upvote 0
I'd wrap it in a change event:

Private Sub Worksheet_Change(ByVal Target As Range)
' Code goes in the Worksheet specific module
Dim Count As Integer
Dim NumToFactor As Single 'Integer limits to < 32768
Dim Factor As Single
Dim y As Single
Dim IntCheck As Single
Count = 0
Dim rng As Range

' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
Set rng = Target.Parent.Range("H2")
' Only look at single cell changes
If Target.Count > 1 Then Exit Sub
' Only look at that range
If Intersect(Target, rng) Is Nothing Then Exit Sub

' Action if Condition(s) are met (do your thing here...)


'***************CODE TO INSERT ************************
Application.EnableEvents = False ' does this go here, followed by:
Range("H3:H99").Clear


Do
NumToFactor = Target.Value
'Force entry of integers greater than 0.
IntCheck = NumToFactor - Int(NumToFactor)
If NumToFactor = 0 Then
Exit Sub
'Cancel is 0 -- allow Cancel.
ElseIf NumToFactor < 1 Then
MsgBox "Please enter an integer greater than zero."
With Target
.Select
.Value = ""
End With
Exit Sub
ElseIf IntCheck > 0 Then
MsgBox "Please enter an integer -- no decimals."
With Target
.Select
.Value = ""
End With
Exit Sub
End If
'Loop until entry of integer greater than 0.
Loop While NumToFactor <= 0 Or IntCheck > 0

For y = 1 To NumToFactor
'Put message in status bar indicating the integer being checked.
Application.StatusBar = "Checking " & y
Factor = NumToFactor Mod y
'Determine if the result of division with Mod is without _
remainder and thus a "factor".

If Factor = 0 Then
'Enter the factor into a column starting with the active cell.
ActiveCell.Offset(Count, 0).Value = y
'Increase the amount to offset for next value.
Count = Count + 1
End If
Next
'Restore Status Bar.
Application.StatusBar = "Ready"

'**************Code To Insert ****************
Application.EnableEvents = True 'and does this go here

' ***************************************


End Sub


I added a little bit of error handling, but only tested it minimally, so you might want to adjust it a bit.

HTH,

Thank you Smitty it works great. I tried to do one thing and that is clear the colomun from H3 down, before it factors the next number I put in the cell. I have managed to clear the column, but it is not allowing the number to be factored.

This is what I know, but do not know how to use it with conditions.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Range("H3:H99").Clear
    '   Code goes in the Worksheet specific module
        Dim Count As Integer
        Dim NumToFactor As Single 'Integer limits to < 32768
        Dim Factor As Single
        Dim y As Single
        Dim IntCheck As Single
        Count = 0
        Dim rng As Range

What Boller's talking about is using Application.EnableEvents = False at the beginning of the code, and setting it true to the end. As for clearing H3:H99 put that before your Do line, right after EnableEvents.



I have placed the code that was suggested where I think it should go based on the last post. Is this correct. I am still very new to VBA and need to get a sound understanding of this "Application.enableEvents" which is why I am asking if I understood the posts correctly.
 
Upvote 0
I have placed the code that was suggested where I think it should go based on the last post. Is this correct. I am still very new to VBA and need to get a sound understanding of this "Application.enableEvents" which is why I am asking if I understood the posts correctly.

That looks to good to me, but I haven't tested it. What happens when you try it?

What EnableEvents does is prevents events from firing. In a change events it prevents what's called recursive looping, where a cell change in itself causes a change, which causes your event to fire again, and it won't stop until you kill it.
 
Upvote 0
That looks to good to me, but I haven't tested it. What happens when you try it?

What EnableEvents does is prevents events from firing. In a change events it prevents what's called recursive looping, where a cell change in itself causes a change, which causes your event to fire again, and it won't stop until you kill it.


This works, a little to good. I modified the range to allows for the factoring of 4 numbers in this range

'("B2, D2, F2, H2")


The trouble is that when I put a value in another of these cells the clear command clears the factored numbers before I want them to be cleared.


How complicated is the code to evaluate the aforementioned cells, so that when I enter a number to be factored it factors, stays populated while I enter numbers in t D3, F3 and H3, and only when a new number is entered into B2 does B3:99, and a number entered into D2 does D3:D99, and so on for the range of

'("B3:B99, D3:D99, F3:F99, H3:H99") clear?

For now I will just remove the clear. Having a four (4) cell range makes it possible to factor two (2) sets of fractions. and see the results until I am ready to factor another set of fractions for example both fractions are prime. If adding or subtracting I would have a denom of 5*17 with num of 3*17 and 11*5

3 11 3*17 11*5
- --- ---- -----
5 17 5*17 5*17
 
Upvote 0
That looks to good to me, but I haven't tested it. What happens when you try it?

I mistyped there it should have been "it looks good to me"...Sorry about that.

If you want to expand the range I'd suggest looking at Select Case in the VB helpfile. It will let you stop and identify which Target cell has received an entry (e.g. Target.Column = 2).

Unfortunately, I'm outta' here for the night, but I'll try to check in tomorrow afternoon when I get back.
 
Upvote 0

Forum statistics

Threads
1,224,558
Messages
6,179,512
Members
452,920
Latest member
jaspers

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top