Up for a challenge?

M

Mr noob

New Member
Joined
Nov 5, 2011
Messages
49
This is a VBA code I have been working on for a while adding to it as my spread sheet grows, but it has gotten rather long and untidy. Is there anyone out there willing to try and clean this mess up? it will be a good challenge I promise.:eek:

Sub subtract()
'submit report information onto other sheets
'uses submit button on report page




Application.ScreenUpdating = False
Sheets("Planning ").Visible = True
Sheets("planning ").Protect userinterfaceonly:=True
Sheets("monthly report ").Visible = True


If Cells(1, 9).Value = "0" Then
MsgBox "Error: this workbook may be unsaved. please select day shift or night shift."
Exit Sub


Else
'submit report information onto other sheets
' subtracts from running total
Dim a As Long
Dim b As Long
Dim answer As Long
Dim myrow1 As String
Dim myrow2 As String
Dim r As Integer

For r = 7 To 16
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 20 To 29
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 33 To 42
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 46 To 55
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 59 To 68
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 72 To 81
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 85 To 94
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 98 To 107
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 111 To 120
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 124 To 133
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 137 To 146
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 150 To 159
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 163 To 172
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
End If

' saves information onto gantt graph data sheet run time

Const SetCnt As Integer = 12
Const GroupSetCnt As Long = 9

Const ReportStartRow As Long = 7
Const DataStartRow As Long = 2
Const DataStartCol As Long = 27 '27 is Column "AA"

Dim DataRowNo As Long
Dim DataColNo As Long
Dim ReportRowNo As Long

Dim I As Integer

'Therefore Data!aa2 must = Report!j7 + Data!aa2
'j7 to j16 - aa2 to aa11
'j20 to j29 - ab2 to ab11 etc

Dim Offset As Long

Debug.Print "*******************"
For Offset = 0 To SetCnt

'Debug.Print "Offset: " & Offset

For I = 0 To GroupSetCnt
ReportRowNo = I + ReportStartRow + (Offset * GroupSetCnt + Offset * 4)
DataRowNo = I + DataStartRow
DataColNo = DataStartCol + Offset

'Debug.Print "j" & ReportRowNo & " -> " & DataRowNo, DataColNo
Sheets("Data ").Cells(DataRowNo, DataColNo) = Sheets("Data ").Cells(DataRowNo, DataColNo) + Sheets("Report").Cells(ReportRowNo, "j")
Next I
Next Offset

' saves information onto gantt graph data sheet set up time

Const SetCnt1 As Integer = 12
Const GroupSetCnt1 As Long = 9

Const ReportStartRow1 As Long = 7
Const DataStartRow1 As Long = 18
Const DataStartCol1 As Long = 27 '27 is Column "AA"

Dim DataRowNo1 As Long
Dim DataColNo1 As Long
Dim ReportRowNo1 As Long

Dim o As Integer

'Therefore Data!aa2 must = Report!k7 + Data!aa2
'k7 to k16 - aa17 to aa27
'k20 to k29 - ab17 to ab27 etc

Dim Offsett As Long

Debug.Print "*******************"
For Offsett = 0 To SetCnt1
'Debug.Print "Offsett: " & Offsett

For o = 0 To GroupSetCnt1
ReportRowNo1 = o + ReportStartRow1 + (Offsett * GroupSetCnt1 + Offsett * 4)
DataRowNo1 = o + DataStartRow1
DataColNo1 = DataStartCol1 + Offsett

'Debug.Print "k" & ReportRowNo1 & " -> " & DataRowNo1, DataColNo1
Sheets("Data ").Cells(DataRowNo1, DataColNo1) = Sheets("Data ").Cells(DataRowNo1, DataColNo1) + Sheets("Report").Cells(ReportRowNo1, "k")
Next o
Next Offsett
' saves information onto gantt graph data sheet down time
Sheets("Data ").Cells(33, "aa") = Sheets("Data ").Cells(33, "aa") + Sheets("Report").Cells(15, "X")
Sheets("Data ").Cells(33, "ab") = Sheets("Data ").Cells(33, "ab") + Sheets("Report").Cells(28, "X")
Sheets("Data ").Cells(33, "ac") = Sheets("Data ").Cells(33, "ac") + Sheets("Report").Cells(41, "X")
Sheets("Data ").Cells(33, "ad") = Sheets("Data ").Cells(33, "ad") + Sheets("Report").Cells(54, "X")
Sheets("Data ").Cells(33, "ae") = Sheets("Data ").Cells(33, "ae") + Sheets("Report").Cells(67, "X")
Sheets("Data ").Cells(33, "af") = Sheets("Data ").Cells(33, "af") + Sheets("Report").Cells(80, "X")
Sheets("Data ").Cells(33, "ag") = Sheets("Data ").Cells(33, "ag") + Sheets("Report").Cells(93, "X")
Sheets("Data ").Cells(33, "ah") = Sheets("Data ").Cells(33, "ah") + Sheets("Report").Cells(106, "X")
Sheets("Data ").Cells(33, "ai") = Sheets("Data ").Cells(33, "ai") + Sheets("Report").Cells(119, "X")
Sheets("Data ").Cells(33, "aj") = Sheets("Data ").Cells(33, "aj") + Sheets("Report").Cells(132, "X")
Sheets("Data ").Cells(33, "ak") = Sheets("Data ").Cells(33, "ak") + Sheets("Report").Cells(145, "X")
Sheets("Data ").Cells(33, "al") = Sheets("Data ").Cells(33, "al") + Sheets("Report").Cells(158, "X")
Sheets("Data ").Cells(33, "am") = Sheets("Data ").Cells(33, "am") + Sheets("Report").Cells(171, "X")

' transfere Macro Transveres information onto monthly report page


Range("T17,T30,T43,T56,T69,T82,T95,T108,T121,T134,T147,T160,T173").Select
Selection.Copy
Sheets("Monthly report ").Select
Dim rngDate As Range, rngFound As Range
Dim aDate As Date, Shift As String

aDate = Sheet1.Cells(2, 2).Value
Shift = Sheet1.Cells(4, 2)

Set rngDate = Range("d3:bt3")
Set rngFound = rngDate.Find(What:=aDate)

If Not rngFound Is Nothing Then

'True is selection by check box eg true = night shift

If Shift = "True" Then
rngFound.Offset(3).Select
Selection.Offset(, 1).Select
Else
rngFound.Offset(3).Select
End If
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Report").Select

' transfere Macro Transveres machine efficincy information onto monthly report page


Range("X17,X30,X43,X56,X69,X82,X95,X108,X121,X134,X147,X160,X173").Select
Selection.Copy
Sheets("Monthly report ").Select
Dim rngDate1 As Range, rngFound1 As Range
Dim aDate1 As Date, Shift1 As String

aDate1 = Sheet1.Cells(2, 2).Value
Shift1 = Sheet1.Cells(4, 2)

Set rngDate1 = Range("d3:bt3")
Set rngFound1 = rngDate1.Find(What:=aDate1)

If Not rngFound1 Is Nothing Then

'True is selection by check box eg true = night shift

If Shift1 = "True" Then
rngFound1.Offset(19).Select
Selection.Offset(, 1).Select
Else
rngFound1.Offset(19).Select
End If
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Report").Select
Range("E4").Select

' transfere Macro Transveres machine utilisation information onto monthly report page


Range("V17,V30,V43,V56,V69,V82,V95,V108,V121,V134,V147,V160,V173").Select
Selection.Copy
Sheets("Monthly report ").Select
Dim rngDate2 As Range, rngFound2 As Range
Dim aDate2 As Date, Shift2 As String

aDate2 = Sheet1.Cells(2, 2).Value
Shift2 = Sheet1.Cells(4, 2)

Set rngDate2 = Range("d3:bt3")
Set rngFound2 = rngDate2.Find(What:=aDate2)

If Not rngFound2 Is Nothing Then

'True is selection by check box eg true = night shift

If Shift2 = "True" Then
rngFound2.Offset(35).Select
Selection.Offset(, 1).Select
Else
rngFound2.Offset(35).Select
End If
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Transfere macro moves people efficency into monthly data
'
'



Sheets("Monthly Report ").Select
Dim rngDate5 As Range, rngFound5 As Range
Dim aDate5 As Date, Shift5 As String

aDate5 = Sheet1.Cells(2, 2).Value
Shift5 = Sheet1.Cells(4, 2)

Set rngDate5 = Range("d3:bt3")
Set rngFound5 = rngDate5.Find(What:=aDate5)

If Not rngFound5 Is Nothing Then
'True is selection by check box eg true = night shift
If Shift = "True" Then
rngFound5.Offset(52).Select
Selection.Offset(, 1).Select
Else
rngFound5.Offset(52).Select
End If
End If
Selection = Sheets("report").Evaluate("N17+N30+N43+N56+N69+N82+N95+N108+N121+N134+N147+N160+N173")

'Transfere macro moves machine downtime into monthly data
'
'



Sheets("Monthly Report ").Select
Dim rngDate6 As Range, rngFound6 As Range
Dim aDate6 As Date, Shift6 As String

aDate6 = Sheet1.Cells(2, 2).Value
Shift6 = Sheet1.Cells(4, 2)

Set rngDate6 = Range("d3:bt3")
Set rngFound6 = rngDate6.Find(What:=aDate6)

If Not rngFound6 Is Nothing Then
'True is selection by check box eg true = night shift
If Shift = "True" Then
rngFound6.Offset(54).Select
Selection.Offset(, 1).Select
Else
rngFound6.Offset(54).Select
End If
End If
Selection = Sheets("report").Evaluate("x7+x20+x33+x46+x59+x72+x85+x98+x111+x124+x137+x150+x163")

Sheets("Report").Select
Range("E4").Select
Sheets("Planning ").Visible = False
Sheets("monthly report ").Visible = False
Application.ScreenUpdating = True
Sheet1.Cells(1, 2).Value = "Submitted"


End Sub
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
Mr noob,

My best advise would be to re-do everything from scratch.
This is what I would do myself.

As you have been using your Excel file for a long time, you probably know very well today what your actual need is, and you probably know where it should become more flexible.
Therefore, you can think in a somewhat more abstract way and come to a totally new design of your application.

I advice you the use named range and never use column or row number in your VBA, unless for one-shot code.
Even better, you should go for LISTS if you are using Excel 2010 or 2007.
When designing your Excel application, keep the number of lists to the strict minimum actually needed.
For example: no need for a "Canada sales" and a "US sales" table, just add a column to one list that indicate Canada of US.

Absolutely avoid storing data in another way than by using LISTS or tables where columns have a unique meaning.
Also avoid formulas as much as possible on your spreadsheet.
Leave formulas for unimportant function that the end-user can control, like unit conversion on a per-record basis.
If you need to build summaries and report, try to use PivotTables instead of anything else.

If you proceed that way, you are using Excel nealry like a database, and conversion to a databae woudl be easy.
Excel is not a tool to store data, unless you try to use Excel like a database.
Excel formulas are old technology, try to avoid them as much as possible.
 
Last edited:
Upvote 0
I guess the other thing to add is......if it ain't broke, don't fix it !!!
Make a copy of the workbook and as lalbatros iterated, break it down and either start again OR look at what you want from the code and consider different ways of doing it.....but I can't imagine anyone wanting to jump in and do the dirty work !!
 
Upvote 0
Thanks too all who replied

Mohammad it would take me a month to explain what I need to do... but in a nut shell this is just one of 15 codes of similar size I use it to do a weekly Plan for my production runs, then capture the daily production results compare this to the plan save this data onto a monthly report which compares usages,rejects,down time etc it then highlights and problem areas and e-mails the respective parties the "non conforming" results. Actually sounds rather easy when I put it that way:) but there is alot more to it than that.

Lalbatros I am still very new to VBA and well "advanced" excel and all this code and the spread sheets I have done, I have had to teach myself with the help of this site and people like yourself. so please excuse me when I say... WHAT!!! I think my research has just begun.

Micheal I sense a little interest are you sure I can't twist that rubber arm.

In all sincerity thou, I do appreciate the responses and to be honest I was hoping to get a VBA guru that was bored stiff to preform some magic.
 
Upvote 0
For what it's worth, I'll get you started......
Replace this block of code
Code: 
For r = 7 To 16
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 20 To 29
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 33 To 42
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 46 To 55
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 59 To 68
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 72 To 81
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 85 To 94
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 98 To 107
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 111 To 120
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 124 To 133
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 137 To 146
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 150 To 159
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
For r = 163 To 172
myrow1 = "d" & r
myrow2 = "g" & r
a = Sheets("Planning ").Range(myrow1)
b = Sheets("Report").Range(myrow2)
answer = a - b
Sheets("Planning ").Range(myrow1) = answer
Next r
End If

WITH THIS

Code: 
For r = 7 To 172
x = 0
Do While x < 10
        myrow1 = "d" & r
        myrow2 = "g" & r
        a = Sheets("Planning ").Range(myrow1)
        b = Sheets("Report").Range(myrow2)
        Sheets("Planning ").Range(myrow1) = a - b
        r = r + 1
        x = x + 1
Loop
x = 1
r = r + 2
    Next r
 
Upvote 0
Michael M

Thanks :cool: you do not understand how much that has helped, as a lot of my VBA is repeating. Now I can use this same concept for most of the others.

See I knew I could twist that rubber arm:LOL:
 
Upvote 0
Glad I got the ball rolling.....you can also eliminate the Select.Selection parts

Stuff like
Code: 
Sheets("Sheet1").select
Range("A1").select
selection.copy

can be reduced to
Code: 
Sheets("Sheet1").Range("A1").copy
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
VBA only copy data from one sheet that isn't already on another sheet
Replies
0
Views
612
mik1996
M
S
  • Question
Autofilter in VBA when criteria is has more words separated by a comma in 2 sheets
Replies
0
Views
603
shafiey
S
T
  • Question
trying to understand why my code is crashing
Replies
4
Views
407
Peter_SSs
Peter_SSs
M
  • Question
Need to exclude "" cells which contains formulas in a Range
Replies
6
Views
500
kevin9999
K
J
  • Question
Update of cell not showing correctly without manual enter
Replies
1
Views
471
JannetteChristie
J

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,399
Latest member
alchavar

Share this page

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