PDA

View Full Version : Tidy up of code required



skelly022782
08-30-2010, 07:05 AM
Hi Guys-

I'm a little green behind the ears when it comes to VBA code writing. recently I wrote a code to automate a procedure I have here at work. The code actually works as intended but I was hoping maybe a couple seasoned code writers could take a look and give me some advice on how I could have wrote the code better so I can improve on it for next time.

Thanks!!

Option Explicit

Public CoAmount As Double
Public ChangeOrderNum As String
Public CoDate As String, ReturnDate As String
Public Subcontractor As String
Public ContractNum As String
Public LineNum As String
Public OCO As String
Sub GetChangeOrderInfo()
Sheets("Project Master File").Select
Dim ChangeOrderRow As Integer
Range("B8").Select
Do While Selection.Row < 300
If Selection.Value > 0 Then
ChangeOrderRow = Selection.Row
CoDate = Cells(ChangeOrderRow, 3).Value
ReturnDate = Cells(ChangeOrderRow, 4).Value
Subcontractor = Cells(ChangeOrderRow, 1).Value
ContractNum = Right(Subcontractor, 6)
LineNum = Cells(ChangeOrderRow, 5).Value
OCO = Cells(ChangeOrderRow, 8).Value
CoAmount = Cells(ChangeOrderRow, 12).Value
ChangeOrderNum = Cells(ChangeOrderRow, 2).Value
EnterCoInfo
Sheets("Project Master File").Select
End If
Selection.Offset(1, 0).Select
Loop
Format
End Sub
Sub Format()
Sheets("Subcontractor Change Order Log").Select
Range("A7:I55").Select
ActiveWindow.SmallScroll Down:=-33
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("I:I").Select
Selection.Style = "Currency"


'Sorts
Range("A7:I51").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWorkbook.Worksheets("Subcontractor Change Order Log").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Subcontractor Change Order Log").Sort.SortFields. _
Add Key:=Range("B8:B51"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Subcontractor Change Order Log").Sort.SortFields. _
Add Key:=Range("D8:D51"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Subcontractor Change Order Log").Sort
.SetRange Range("A7:I51")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Formatting
Columns("C:E").Select
Selection.NumberFormat = "General"

Columns("A:A").Select
Selection.NumberFormat = "mm/dd/yy;@"

End Sub


Option Explicit
Sub EnterCoInfo()
Sheets("Subcontractor Change Order Log").Select
Dim DateCol As Integer
Dim SubCol As Integer
Dim ContractNumCol As Integer
Dim CoNumCol As Integer
Dim LineNumCol As Integer
Dim ReturnDateCol As Integer
Dim OcoCol As Integer
Dim FirstBlankRow As Integer
Dim CoAmountCol As Integer

DateCol = 1
SubCol = 2
ContractNumCol = 3
CoNumCol = 4
LineNumCol = 5
ReturnDateCol = 6
OcoCol = 7
CoAmountCol = 9
Range("A7").Select
Do While Selection.Row < 150
If Cells(Selection.Row, SubCol).Value = Subcontractor _
And Cells(Selection.Row, CoNumCol).Value = ChangeOrderNum And Cells(Selection.Row, CoAmountCol).Value = CoAmount Then
GoTo SkipLoop
End If
Selection.Offset(1, 0).Select
Loop
Range("A7").Select
Do Until IsEmpty(Selection.Value)
Selection.Offset(1, 0).Select
Loop
FirstBlankRow = Selection.Row
Cells(FirstBlankRow, DateCol).Value = CoDate
Cells(FirstBlankRow, SubCol).Value = Subcontractor
Cells(FirstBlankRow, ContractNumCol).Value = ContractNum
Cells(FirstBlankRow, CoNumCol).Value = ChangeOrderNum
Cells(FirstBlankRow, LineNumCol).Value = LineNum
Cells(FirstBlankRow, ReturnDateCol).Value = ReturnDate
Cells(FirstBlankRow, OcoCol).Value = OCO
Cells(FirstBlankRow, CoAmountCol).Value = CoAmount
SkipLoop:
End Sub

Bob Phillips
08-30-2010, 07:53 AM
You could try not having multiple Option Explicits in there, tremove window scrolls, avoid selecting, avoid Gotos, and tell us what it does rather than have us guessing.

skelly022782
08-30-2010, 10:25 AM
Sorry, I should have been more specific. The Macro pulls information from a masterfile tab of an excel workbook to populate a change order log tab in the same workbook. In the change order # column, if the value is not empty or greater than 0, it assumes it's a change order and takes all the relevant information and enters it into the change order log. I then used the record macro feature to sort and format accordingly.

So try to avoid goto's and selects?

skelly022782
08-30-2010, 10:27 AM
When you say avoid window scrolls, do you mean try to make the subs smaller and on different modules?

Bob Phillips
08-30-2010, 03:47 PM
No, I mean junk the Activewindow,Scroll... lines.

austenr
08-30-2010, 04:51 PM
Might help if the OP posted a useful sample to look at. Just sayin.

Blade Hunter
08-30-2010, 07:08 PM
OK, I did a 2 minute cleanup on this, I don't have your data so I don't know if it will work or not so try it on a copy but it is a lot easier to read and modify if you can tell us what you need changed.


Option Explicit

Public CoAmount As Double
Public ChangeOrderNum As String
Public CoDate As String, ReturnDate As String
Public Subcontractor As String
Public ContractNum As String
Public LineNum As String
Public OCO As String

Sub GetChangeOrderInfo()
Sheets("Project Master File").Select
Dim ChangeOrderRow As Long
For ChangeOrderRow = 8 to 300
If Range("B" & ChangeOrderRow).Value > 0 Then
CoDate = Cells(ChangeOrderRow, 3).Value
ReturnDate = Cells(ChangeOrderRow, 4).Value
Subcontractor = Cells(ChangeOrderRow, 1).Value
ContractNum = Right(Subcontractor, 6)
LineNum = Cells(ChangeOrderRow, 5).Value
OCO = Cells(ChangeOrderRow, 8).Value
CoAmount = Cells(ChangeOrderRow, 12).Value
ChangeOrderNum = Cells(ChangeOrderRow, 2).Value
EnterCoInfo
Sheets("Project Master File").Select
End If
Next
Format
End Sub
Sub Format()
Sheets("Subcontractor Change Order Log").Select
Range("A7:I55").HorizontalAlignment = xlCenter
Columns("I:I").Style = "Currency"
ActiveWorkbook.Worksheets("Subcontractor Change Order Log").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Subcontractor Change Order Log").Sort.SortFields. _
Add Key:=Range("B8:B51"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Subcontractor Change Order Log").Sort.SortFields. _
Add Key:=Range("D8:D51"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Subcontractor Change Order Log").Sort
.SetRange Range("A7:I51")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("C:E").NumberFormat = "General"
Columns("A:A").NumberFormat = "mm/dd/yy;@"
End Sub

Sub EnterCoInfo()
Sheets("Subcontractor Change Order Log").Select
Dim DateCol As Integer
Dim SubCol As Integer
Dim ContractNumCol As Integer
Dim CoNumCol As Integer
Dim LineNumCol As Integer
Dim ReturnDateCol As Integer
Dim OcoCol As Integer
Dim FirstBlankRow As Integer
Dim CoAmountCol As Integer
Dim X As Long

DateCol = 1
SubCol = 2
ContractNumCol = 3
CoNumCol = 4
LineNumCol = 5
ReturnDateCol = 6
OcoCol = 7
CoAmountCol = 9
Range("A7").Select
For X = 7 To 150
If Cells(X, SubCol).Value = Subcontractor And Cells(X, CoNumCol).Value = ChangeOrderNum And Cells(X, CoAmountCol).Value = CoAmount Then
Exit Sub
End If
Next
FirstBlankRow = Range("A7").End(xlDown).Offset(1, 0).Row
Cells(FirstBlankRow, DateCol).Value = CoDate
Cells(FirstBlankRow, SubCol).Value = Subcontractor
Cells(FirstBlankRow, ContractNumCol).Value = ContractNum
Cells(FirstBlankRow, CoNumCol).Value = ChangeOrderNum
Cells(FirstBlankRow, LineNumCol).Value = LineNum
Cells(FirstBlankRow, ReturnDateCol).Value = ReturnDate
Cells(FirstBlankRow, OcoCol).Value = OCO
Cells(FirstBlankRow, CoAmountCol).Value = CoAmount
End Sub


Try not to use select as it wastes resources.