Help clean up this code...

S

scottnshelly

I have what started out as a simple little code that i played with to
much and made too complicated for me to wrap my little head around.
Can you take gander at it and clean it up a little.
It may be hard for you to tell without running the same program as i d
at work. Basically i run a report, then export it to my clipboard.
the code does (is supposed to do) the rest.
A few problems i am having include: the last msgbox doesn't pop up. i
P&H Sales or anything listed after it is 0, it returns Cust Serv'
numbers instead of "n/c" like i asked.
Also, I want there to be an error message like 'Please export data t
your clipboard". I'm new to the 'on error' function so i don't kno
how to do that.
Any help would be very much appreciated!

here is the code:

Private Sub CommandButton1_Click()
If Sheet1.Name = "armdore" Then
Sheet1.Name = "Ardmore"
Else
End If

Msg = "Did you Export the CMS Data to your Clipboard?"
Style = vbYesNo + vbDefaultButton2
Title = "QUESTION"
Ctxt = 1000
response = MsgBox(Msg, Style, Title, Help, Ctxt)

If response = vbYes Then

Application.ScreenUpdating = False

Worksheets("RECAP").Select
On Error GoTo cancelled
Columns("aa:iv").ClearContents
Sheet2.Paste Destination:=Sheet2.Range("aA1")
On Error GoTo cancelled
Sheets("RECAP").Range("ah7").Select
Sheets("ardmore").Select
Range("c9").Select

Do

If IsEmpty(ActiveCell) = False Then

ActiveCell.Offset(0, 1).Select

End If

Loop Until IsEmpty(ActiveCell) = True
'inbound
Sheets("RECAP").Select
Selection.Copy
Sheets("ardmore").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'customer service
Sheets("RECAP").Select
ActiveCell.Offset(1, 0).Select
Selection.Copy
Sheets("ardmore").Select
ActiveCell.Offset(3, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'TPF sales
Sheets("RECAP").Select
ActiveCell.Offset(1, -1).Select
Selection.Copy
Sheets("ardmore").Select
ActiveCell.Offset(3, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'TPF corp Sales
Sheets("RECAP").Select
ActiveCell.Offset(1, 0).Select
Selection.Copy
Sheets("ardmore").Select
ActiveCell.Offset(3, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'P&H sales
Sheets("RECAP").Select
ActiveCell.Offset(2, 1).Select
Selection.Copy
Sheets("ardmore").Select
ActiveCell.Offset(3, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'MC sales
Sheets("RECAP").Select
ActiveCell.Offset(-1, 0).Select
Selection.Copy
Sheets("ardmore").Select
ActiveCell.Offset(6, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'HS Sales
Sheets("RECAP").Select
ActiveCell.Offset(2, 0).Select
Selection.Copy
Sheets("RECAP").Range("ah7").Select
Sheets("ardmore").Select
ActiveCell.Offset(6, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'HS Service
Sheets("RECAP").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
End If
Else
Selection.Copy
Sheets("RECAP").Range("ah7").Select
Sheets("ardmore").Select
ActiveCell.Offset(3, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'MC Serv
Sheets("RECAP").Select
ActiveCell.Offset(1, 0).Select
Selection.Copy
Sheets("RECAP").Range("ah7").Select
Sheets("ardmore").Select
ActiveCell.Offset(-6, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
'P&H Serv
Sheets("RECAP").Select
ActiveCell.Offset(1, 0).Select
Selection.Copy
Sheets("RECAP").Range("ah7").Select
Sheets("ardmore").Select
ActiveCell.Offset(-6, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False

MsgBox "Service Levels and ASA's posted for " &
Sheets("RECAP").Range("ab2").Value, vbInformation, "POSTED"

Application.ScreenUpdating = True

Sheets("RECAP").Columns("z:iv").ClearContents

'ElseIf response = vbNo Then

'MsgBox "Run Daily Ops Report and Export Data to Clipboard"

End If

cancelled:

Sheets("ardmore").Select

End Sub
 
D

Don Guillett

One thing that will help is to get rid of a lot of selections. You do NOT
have to goto a sheet to copy/paste
Sheets("RECAP").Select
Selection.Copy
Sheets("ardmore").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Click to expand...
can be
Sheets("ardmore").range("includerangehere").value=Sheets("RECAP").range("sam
esizerangehere")
ie
Sheets("ardmore").range("a1:d1").value=Sheets("RECAP").range("b1:e1")
Sheets("a1").range("includerangehere").value=Sheets("RECAP").range("x1")
=========
 
B

Bob Kilmer

I don't know if your code lost the formatting in the posting, but here, I
have indented it, formatted it and moved the pastespecial to a gosub at the
bottom to get that visually out of your way. I have inserted the tildes to
maintain the format in the post. Hopefully, it 'll work. Just replace all
tildes with a space to restore the code. At least if it is well formatted,
it is easier to analyze and simplify.

As Don has already mentioned, you do not need to select to copy and paste (I
know the macro recorder does this, but....) . You can usually assign one
range the value of another directly. Usually, to move around a spreadsheet,
and even from sheet to sheet or workbook to workbook, variables that store
range objects or their addresses are incremented and used to identify cells
to operate on.

I will post a little example of error trapping in another post.

Bob Kilmer

'-----------------------
Option Explicit

Private Sub CommandButton1_Click()
~~~If Sheet1.Name = "armdore" Then
~~~~~~Sheet1.Name = "Ardmore"
~~~Else
~~~End If

~~~Msg = "Did you Export the CMS Data to your Clipboard?"
~~~Style = vbYesNo + vbDefaultButton2
~~~Title = "QUESTION"
~~~Ctxt = 1000
~~~response = MsgBox(Msg, Style, Title, Help, Ctxt)

~~~If response = vbYes Then

~~~~~~Application.ScreenUpdating = False

~~~~~~Worksheets("RECAP").Select
~~~~~~On Error GoTo cancelled
~~~~~~
~~~~~~Columns("aa:iv").ClearContents
~~~~~~Sheet2.Paste Destination:=Sheet2.Range("aA1")
~~~~~~
~~~~~~On Error GoTo cancelled
~~~~~~Sheets("RECAP").Range("ah7").Select
~~~~~~Sheets("ardmore").Select
~~~~~~Range("c9").Select

~~~~~~Do
~~~~~~~~~If IsEmpty(ActiveCell) = False Then
~~~~~~~~~~~~ActiveCell.Offset(0, 1).Select
~~~~~~~~~End If
~~~~~~Loop Until IsEmpty(ActiveCell) = True
~~~~~~
~~~~~~'inbound
~~~~~~Sheets("RECAP").Select
~~~~~~Selection.Copy
~~~~~~Sheets("ardmore").Select
~~~~~~GoSub Paste_Special
~~~~~~
~~~~~~'customer service
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(1, 0).Select
~~~~~~Selection.Copy
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(3, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~'TPF sales
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(1, -1).Select
~~~~~~Selection.Copy
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(3, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~'TPF corp Sales
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(1, 0).Select
~~~~~~Selection.Copy
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(3, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~'P&H sales
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(2, 1).Select
~~~~~~Selection.Copy
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(3, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~'MC sales
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(-1, 0).Select
~~~~~~Selection.Copy
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(6, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~'HS Sales
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(2, 0).Select
~~~~~~Selection.Copy
~~~~~~Sheets("RECAP").Range("ah7").Select
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(6, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~'HS Service
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(1, 0).Select
~~~~~~If ActiveCell.Value = "" Then
~~~~~~End If
~~~Else
~~~~~~Selection.Copy
~~~~~~Sheets("RECAP").Range("ah7").Select
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(3, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~'MC Serv
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(1, 0).Select
~~~~~~Selection.Copy
~~~~~~Sheets("RECAP").Range("ah7").Select
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(-6, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~'P&H Serv
~~~~~~Sheets("RECAP").Select
~~~~~~ActiveCell.Offset(1, 0).Select
~~~~~~Selection.Copy
~~~~~~Sheets("RECAP").Range("ah7").Select
~~~~~~Sheets("ardmore").Select
~~~~~~ActiveCell.Offset(-6, 0).Select
~~~~~~GoSub Paste_Special

~~~~~~MsgBox "Service Levels and ASA's posted for " & _
~~~~~~Sheets("RECAP").Range("ab2").Value, vbInformation, "POSTED"

~~~~~~Application.ScreenUpdating = True

~~~~~~Sheets("RECAP").Columns("z:iv").ClearContents

~~~~~~'ElseIf response = vbNo Then

~~~~~~'MsgBox "Run Daily Ops Report and Export Data to Clipboard"

~~~End If

cancelled:

~~~Sheets("ardmore").Select

Exit Sub
Paste_Special:
~~~~~~Call Selection.PasteSpecial( _
~~~~~~~~~Paste:=xlPasteValues, _
~~~~~~~~~Operation:=xlNone, _
~~~~~~~~~SkipBlanks:=False, _
~~~~~~~~~Transpose:=False)
Return
End Sub





scottnshelly > said:
I have what started out as a simple little code that i played with too
much and made too complicated for me to wrap my little head around.
Can you take gander at it and clean it up a little.
It may be hard for you to tell without running the same program as i do
at work. Basically i run a report, then export it to my clipboard.
the code does (is supposed to do) the rest.
A few problems i am having include: the last msgbox doesn't pop up. if
P&H Sales or anything listed after it is 0, it returns Cust Serv's
numbers instead of "n/c" like i asked.
Also, I want there to be an error message like 'Please export data to
your clipboard". I'm new to the 'on error' function so i don't know
how to do that.
Any help would be very much appreciated!

here is the code:
Click to expand...
<removed for brevity>
 
B

Bob Kilmer

Examples of error handling. Also see Help regarding On Error.

Option Explicit
'--------------------------------
Sub ErrExample1()
'if an error occurs, lets you know, exits
Dim x As Integer
On Error GoTo ErrHandler
Let x = 1 / 0

Exit Sub
ErrHandler:
Dim errmsg As String
Let errmsg = _
"Number:" & Err.Number & vbNewLine & _
"Description: " & Err.Description & vbNewLine & _
"Source: " & Err.Source
Call MsgBox(errmsg, , "Oops!")

End Sub

'--------------------------------
Sub ErrExample2()
'raise and handle your own error
On Error GoTo ErrHandler
'some code'
'raise my own error'
Call Err.Raise(666, ThisWorkbook.VBProject.Name, "Heed my custom error
message!")
'some code'
Call MsgBox("done")
Exit Sub
ErrHandler:
Dim errmsg As String
Let errmsg = _
"Number:" & Err.Number & vbNewLine & _
"Description: " & Err.Description & vbNewLine & _
"Source: " & Err.Source
Call MsgBox(errmsg, , "Oops!")
Resume Next 'go back to line after error
End Sub

'--------------------------------
Sub ErrExample3()
'try to recover from an error
Dim x As Single, a As Single
Let x = 0
Let a = 0
On Error GoTo ErrHandler
Let x = 1 / a 'divide by zero
Call MsgBox(x)
Exit Sub
ErrHandler:
Dim errmsg As String
If Err.Number = 11 Then
Let errmsg = "can't divide by zero, try 4"
Call MsgBox(errmsg)
Let a = 4
Resume 'tries the division again
Else
Let errmsg = _
"Number:" & Err.Number & vbNewLine & _
"Description: " & Err.Description & vbNewLine & _
"Source: " & Err.Source
Call MsgBox(errmsg, , "Oops!")
End If
End Sub
 
B

Bob Kilmer

message
<in essence, "help clean up this code", lengthy message omitted>

I believe the following simplification fairly represents your original code.
I set range variables to your starting cells, then use your offsets to
manipulate the values. Check that the offsets are correct. This code is not
tested. Not all of the original code present makes sense, but I guess it is
a work in progress.

Get the basic code working correctly when everything else is right (the
data, the user's behaviour), then work out error handling later. If it
helps, assume the user has selected the data to the clipboard, and get that
code working separately (start by a copying your code into a separate sub,
then pare it down). Then assume they have not and get that code working
separately (again, use another copy of the code). Then either put the two
together, or perhaps better, leave each one as a their own sub and call them
from the Click event after you confirm what the user has done.

Private Sub CommandButton1_Click()
If <user has exported the CMS data> Then
Call DataExported()
Else
Call DataNotExported()
End If
End Sub

'-------------------------------------------------
Option Explicit

Private Sub CommandButton1_Click()
'create some range variables that will contain cell references so we
'are less dependent upon the activecell and to simplify cell references.
Dim rRecapCellAH7 As Range
Dim rArdmoreCell As Range

'? If Sheet1.Name = "armdore" Then
'? Sheet1.Name = "Ardmore"
'? Else
'? End If

msg = "Did you Export the CMS Data to your Clipboard?"
Style = vbYesNo + vbDefaultButton2
Title = "QUESTION"
Ctxt = 1000
response = MsgBox(msg, Style, Title, Help, Ctxt)

Set rRecapCellAH7 = Sheets("RECAP").Range("ah7")
Set rArdmoreCell = Sheets("ardmore").Range("c9").End(xlToRight).Offset(0,
1)

If response = vbYes Then
Application.ScreenUpdating = False
On Error GoTo cancelled

Worksheets("RECAP").Columns("aa:iv").ClearContents
'(what is the name of sheet?)
Sheet2.Paste Destination:=Sheet2.Range("aA1")

' 'inbound
rArdmoreCell.Value = rRecapCellAH7.Text
' Sheets("RECAP").Select
' Selection.Copy
' Sheets("ardmore").Select
' GoSub Paste_Special

'customer service
rArdmoreCell.Offset(3, 0).Value = rRecapCellAH7.Offset(1, 0).Text
' Sheets("RECAP").Select
' ActiveCell.Offset(1, 0).Select
' Selection.Copy
' Sheets("ardmore").Select
' ActiveCell.Offset(3, 0).Select
' GoSub Paste_Special

'TPF sales
rArdmoreCell.Offset(6, 0).Value = rRecapCellAH7.Offset(2, -1).Text
' Sheets("RECAP").Select
' ActiveCell.Offset(1, -1).Select
' Selection.Copy
' Sheets("ardmore").Select
' ActiveCell.Offset(3, 0).Select
' GoSub Paste_Special

'TPF corp Sales
rArdmoreCell.Offset(9, 0).Value = rRecapCellAH7.Offset(3, -1).Text
' Sheets("RECAP").Select
' ActiveCell.Offset(1, 0).Select
' Selection.Copy
' Sheets("ardmore").Select
' ActiveCell.Offset(3, 0).Select
' GoSub Paste_Special

'P&H sales
rArdmoreCell.Offset(12, 0).Value = rRecapCellAH7.Offset(5, 0).Text
' Sheets("RECAP").Select
' ActiveCell.Offset(2, 1).Select
' Selection.Copy
' Sheets("ardmore").Select
' ActiveCell.Offset(3, 0).Select
' GoSub Paste_Special

'MC sales
rArdmoreCell.Offset(18, 0).Value = rRecapCellAH7.Offset(4, 0).Text
' Sheets("RECAP").Select
' ActiveCell.Offset(-1, 0).Select
' Selection.Copy
' Sheets("ardmore").Select
' ActiveCell.Offset(6, 0).Select
' GoSub Paste_Special

'HS Sales
rArdmoreCell.Offset(24, 0).Value = rRecapCellAH7.Offset(6, 0).Text
' Sheets("RECAP").Select
' ActiveCell.Offset(2, 0).Select
' Selection.Copy
'? Sheets("RECAP").Range("ah7").Select '<< reset active cell?
' Sheets("ardmore").Select
' ActiveCell.Offset(6, 0).Select
' GoSub Paste_Special

'HS Service
rRecapCellAH7.Offset(1, 0).Select
'? Sheets("RECAP").Select
'? ActiveCell.Offset(1, 0).Select
'? If ActiveCell.Value = "" Then
'? End If
Else
'Previous code doesn't specify what the selection is.
Dim rSelection As Range
Set rSelection = Selection
Sheets("ardmore").Select
'Previous code doesn't specify what the ActiveCell is.
Set rArdmoreCell = ActiveCell.Offset(3, 0)
rArdmoreCell.Value = rSelection.Text

'? 'Previous code doesn't specify what the selection is.
' Selection.Copy
'? Sheets("RECAP").Range("ah7").Select '<< reset active cell?
' Sheets("ardmore").Select
'? 'Previous code doesn't specify what the ActiveCell is.
' ActiveCell.Offset(3, 0).Select
' GoSub Paste_Special

'MC Serv
rArdmoreCell.Offset(-6, 0).Value = rRecapCellAH7.Offset(1, 0).Text
' Sheets("RECAP").Select
' ActiveCell.Offset(1, 0).Select
' Selection.Copy
'? Sheets("RECAP").Range("ah7").Select '<< reset active cell?
' Sheets("ardmore").Select
' ActiveCell.Offset(-6, 0).Select
' GoSub Paste_Special

'P&H Serv
rArdmoreCell.Offset(-12, 0).Value = rRecapCellAH7.Offset(1, 0).Text
' Sheets("RECAP").Select
' ActiveCell.Offset(1, 0).Select
' Selection.Copy
'? Sheets("RECAP").Range("ah7").Select '<< reset active cell?
' Sheets("ardmore").Select
' ActiveCell.Offset(-6, 0).Select
' GoSub Paste_Special

MsgBox "Service Levels and ASA's posted for " & _
Sheets("RECAP").Range("ab2").Value, vbInformation, "POSTED"

Application.ScreenUpdating = True

Sheets("RECAP").Columns("z:iv").ClearContents

'ElseIf response = vbNo Then
'MsgBox "Run Daily Ops Report and Export Data to Clipboard"

End If

cancelled:
Sheets("ardmore").Select

Exit Sub
'Paste_Special:
' Call Selection.PasteSpecial( _
' Paste:=xlPasteValues, _
' Operation:=xlNone, _
' SkipBlanks:=False, _
' Transpose:=False)
'Return
End Sub
 
S

scottnshelly

I appreciate everyone's response. I am still having troubles with th
Error handling, however.
I do not have help installed and cannot get it installed as this is
work computer.
Am i supposed to put a reference to the sub errexamples in the code, o
do i make those seperate...?
also, there are at least two lines in the original code that are stil
not working. they are towards the end, just before the 'end if'

MsgBox "Service Levels and ASA's posted for "
Sheets("RECAP").Range("ab2").Value, vbInformation, "POSTED"

Application.ScreenUpdating = True

Sheets("RECAP").Columns("z:iv").ClearContents

Thanks
 
S

scottnshelly

Also,
On the three last 'groups' that are labeled "P&H Serv", "HS Serv" and
"MC Serv", i want it to return "n/c" if it is 0. any suggestions
there?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help merging two VBA codes 2
works in 2007 but not in 2010 0
Something in this is causing a crash 2
stopping a macro 0
Macro Related to Paste Values 2
Having difficulty copying and pasting on VBA 3
Macro that worked stopped working 2
Help with code please 4

Top