problem working with psDivide and psMultiply

[technoguy]

when i underline a row containing data and try to perform a psdivide or psMultiply on it ,the underline is getting erased . Could there be any way that i could fix it.

[lucas]

Hi Technoguy,
I have moved this to the Excel help forum. Announcements is where you posted originally and that is obviously not a very good place to post for help with an Excel issue.

If you want to post your code you can post it directly into the post and then select it and hit the VBA button to format it for you. Most folks won't want to download your Word file to look at the code in question.

[Bob Phillips]

Sub psDivide()
On Error GoTo Err_SomeName
If Application.Workbooks.Count = 0 Then
MsgBox "There is no WorkBook"
Exit Sub
End If

'kgg 2/10/207 - change type of multiplier value to variant to all decimal numbers
Dim y As Variant 'The multiplier value, user-defined
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Selection
y = Application.InputBox("Enter selection divisor:", _
Title:="Selection divisor", Default:=10, Type:=1)
Set x = Range("A65536").End(xlUp).Offset(1)
If y = 0 Then Exit Sub 'Cancel button will = 0, hence cancel
If x <> "" Then
Exit Sub
Else
x.Value = y
x.Style = z.Style
x.Copy
z.PasteSpecial Paste:=xlPasteValues, Operation:=xlDivide
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal : )

Exit_SomeName: ' Label to resume after error.
Exit Sub ' Exit before error handler.
Err_SomeName: ' Label to jump to on error.
If Err.Number = 450 Then
strMsg = "The selected range contains different" & vbCrLf & _
"number formats (eg EY0dp and EY1dp)." & vbCrLf & _
"Please ensure the format is consistent throughout" & vbCrLf & _
"the selection and then re-run this command."
MsgBox strMsg, vbCritical, "Error"
Else
strMsg = "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Calling Proc: " & "psDivide()" & vbCrLf & _
"Error Number " & Err.Number & vbCrLf & Err.Description
MsgBox strMsg, vbCritical, "Error"
End If
Resume Exit_SomeName

End Sub

Sub psMultiply()
On Error GoTo Err_SomeName
If Application.Workbooks.Count = 0 Then
MsgBox "There is no WorkBook"
Exit Sub
End If

'kgg 2/10/207 - change type of multiplier value to variant to all decimal numbers
Dim y As Variant 'The multiplier value, user-defined
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Selection
y = Application.InputBox("Enter selection multiply:", _
Title:="Selection multiplier", Default:=10, Type:=1)
Set x = Range("A65536").End(xlUp).Offset(1)
If y = 0 Then Exit Sub 'Cancel button will = 0, hence cancel
If x <> "" Then
Exit Sub
Else: x.Value = y
x.Style = z.Style
Formula_error:
x.Copy
z.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal : )

Exit_SomeName: ' Label to resume after error.
Exit Sub ' Exit before error handler.
Err_SomeName: ' Label to jump to on error.
If Err.Number = 450 Then
strMsg = "The selected range contains different" & vbCrLf & _
"number formats (eg EY0dp and EY1dp)." & vbCrLf & _
"Please ensure the format is consistent throughout" & vbCrLf & _
"the selection and then re-run this command."
MsgBox strMsg, vbCritical, "Error"
Else
strMsg = "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Calling Proc: " & "psMultiply()" & vbCrLf & _
"Error Number " & Err.Number & vbCrLf & Err.Description
MsgBox strMsg, vbCritical, "Error"
End If
Resume Exit_SomeName

End Sub

[Norie]

Instead of using PasteSpecial why not actually just divide the values in VBA and put the result in the cells.

Might involve a bit of looping but it would preserve the formatting.

[technoguy]

when i underline a row or column containing data and try to perform a psdivide or psMultiply on it ,the underline is getting erased . Could there be any way that i could fix it.

Sample code:

Sub psDivide()
On Error GoTo Err_SomeName
If Application.Workbooks.Count = 0 Then
MsgBox "There is no WorkBook"
Exit Sub
End If

'kgg 2/10/207 - change type of multiplier value to variant to all decimal numbers
Dim y As Variant 'The multiplier value, user-defined
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Selection
y = Application.InputBox("Enter selection divisor:", _
Title:="Selection divisor", Default:=10, Type:=1)
Set x = Range("A65536").End(xlUp).Offset(1)
If y = 0 Then Exit Sub 'Cancel button will = 0, hence cancel
If x <> "" Then
Exit Sub
Else: x.Value = y
x.Style = z.Style
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal : )

Exit_SomeName: ' Label to resume after error.
Exit Sub ' Exit before error handler.
Err_SomeName: ' Label to jump to on error.
If Err.Number = 450 Then
strMsg = "The selected range contains different" & vbCrLf & _
"number formats (eg EY0dp and EY1dp)." & vbCrLf & _
"Please ensure the format is consistent throughout" & vbCrLf & _
"the selection and then re-run this command."
MsgBox strMsg, vbCritical, "Error"
Else
strMsg = "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Calling Proc: " & "psDivide()" & vbCrLf & _
"Error Number " & Err.Number & vbCrLf & Err.Description
MsgBox strMsg, vbCritical, "Error"
End If
Resume Exit_SomeName

End Sub
Sub psMultiply()
On Error GoTo Err_SomeName
If Application.Workbooks.Count = 0 Then
MsgBox "There is no WorkBook"
Exit Sub
End If

'kgg 2/10/207 - change type of multiplier value to variant to all decimal numbers
Dim y As Variant 'The multiplier value, user-defined
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Selection
y = Application.InputBox("Enter selection multiply:", _
Title:="Selection multiplier", Default:=10, Type:=1)
Set x = Range("A65536").End(xlUp).Offset(1)
If y = 0 Then Exit Sub 'Cancel button will = 0, hence cancel
If x <> "" Then
Exit Sub
Else: x.Value = y
x.Style = z.Style
Formula_error:
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal : )

Exit_SomeName: ' Label to resume after error.
Exit Sub ' Exit before error handler.
Err_SomeName: ' Label to jump to on error.
If Err.Number = 450 Then
strMsg = "The selected range contains different" & vbCrLf & _
"number formats (eg EY0dp and EY1dp)." & vbCrLf & _
"Please ensure the format is consistent throughout" & vbCrLf & _
"the selection and then re-run this command."
MsgBox strMsg, vbCritical, "Error"
Else
strMsg = "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Calling Proc: " & "psMultiply()" & vbCrLf & _
"Error Number " & Err.Number & vbCrLf & Err.Description
MsgBox strMsg, vbCritical, "Error"
End If
Resume Exit_SomeName

End Sub

[lucas]

Threads merged.

Technoguy, we are usually very friendly here and tolerant of a little confusion. This is the second time I have had to edit your thread because you don't seem to understand how the forum works. By posting a second thread that is basically the same question as the first you have made it hard for the good folks here to follow the progress of your question. Note that it has replies before you posted the second one.....

Please read our FAQ available at the top of each page. Please re-read post #2 of this thread...specifically the part about posting your code......

You don't post a flag so I can't be sure if it is a language problem or not but your username implies that you know how to read and get around on a computer...

[technoguy]

Sorry Folks for the confusion i created. This is the code i am working on. when i perform asn underline on a row or group of cells ans later when i apply a psDivide or PsMultiplyits just undoing the underline operation. The underline is getting erased.

Is there any way that i can make the underline remain even after performing the psDivide or psMultiply operation.

Sample code:

Sub psDivide()
On Error GoTo Err_SomeName
If Application.Workbooks.Count = 0 Then
MsgBox "There is no WorkBook"
Exit Sub
End If

'kgg 2/10/207 - change type of multiplier value to variant to all decimal numbers
Dim y As Variant 'The multiplier value, user-defined
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Selection
y = Application.InputBox("Enter selection divisor:", _
Title:="Selection divisor", Default:=10, Type:=1)
Set x = Range("A65536").End(xlUp).Offset(1)
If y = 0 Then Exit Sub 'Cancel button will = 0, hence cancel
If x <> "" Then
Exit Sub
Else: x.Value = y
x.Style = z.Style
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal : )

Exit_SomeName: ' Label to resume after error.
Exit Sub ' Exit before error handler.
Err_SomeName: ' Label to jump to on error.
If Err.Number = 450 Then
strMsg = "The selected range contains different" & vbCrLf & _
"number formats (eg EY0dp and EY1dp)." & vbCrLf & _
"Please ensure the format is consistent throughout" & vbCrLf & _
"the selection and then re-run this command."
MsgBox strMsg, vbCritical, "Error"
Else
strMsg = "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Calling Proc: " & "psDivide()" & vbCrLf & _
"Error Number " & Err.Number & vbCrLf & Err.Description
MsgBox strMsg, vbCritical, "Error"
End If
Resume Exit_SomeName

End Sub
Sub psMultiply()
On Error GoTo Err_SomeName
If Application.Workbooks.Count = 0 Then
MsgBox "There is no WorkBook"
Exit Sub
End If

'kgg 2/10/207 - change type of multiplier value to variant to all decimal numbers
Dim y As Variant 'The multiplier value, user-defined
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Selection
y = Application.InputBox("Enter selection multiply:", _
Title:="Selection multiplier", Default:=10, Type:=1)
Set x = Range("A65536").End(xlUp).Offset(1)
If y = 0 Then Exit Sub 'Cancel button will = 0, hence cancel
If x <> "" Then
Exit Sub
Else: x.Value = y
x.Style = z.Style
Formula_error:
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal : )

Exit_SomeName: ' Label to resume after error.
Exit Sub ' Exit before error handler.
Err_SomeName: ' Label to jump to on error.
If Err.Number = 450 Then
strMsg = "The selected range contains different" & vbCrLf & _
"number formats (eg EY0dp and EY1dp)." & vbCrLf & _
"Please ensure the format is consistent throughout" & vbCrLf & _
"the selection and then re-run this command."
MsgBox strMsg, vbCritical, "Error"
Else
strMsg = "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Calling Proc: " & "psMultiply()" & vbCrLf & _
"Error Number " & Err.Number & vbCrLf & Err.Description
MsgBox strMsg, vbCritical, "Error"
End If
Resume Exit_SomeName

End Sub

[Bob Phillips]

I showed you in the earlier thread, so what is wrong with what I gave you and why do you keep starting new threads?

[lucas]

Second set of threads merged.....

Technoguy banned for 10 days