Code clean up help

punchinpaper · Dec 20th 2017

Good morning,
I am new to the forum, I joined seeking some experienced assistance. I am hoping that someone would be willing to help me clean up the code below. Obviously I do not have experience with writing macros but through trial and error the code is working basically. I really need to to perform faster, it is a slow to execute code and I was hoping that a more experienced person could identify and clean up some of the issues that I suspect are in the way I wrote this macro.

Thank you for looking.

Code

Sub ACCUBID_EXTENSION_CONSOLIDATION()
'
'
'
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True


    Application.ScreenUpdating = False
    Application.Calculation = xlManual
'
'
'
Sheets("ACCUBID EXTENSION").Visible = True
    Sheets("Accubid Extension").Select
        ActiveSheet.Unprotect "PRECON"
            Range("B2:G10000").Select
                Range("G10000").Activate
                    Selection.ClearContents
            Range("X2:AD10000").Select
                Range("AD10000").Activate
                    Selection.ClearContents
            Range("AK1:AN10000").Select
                Range("AN10000").Activate
                    Selection.ClearContents
            Range("AT2:AQ10000").Select
                Range("AQ10000").Activate
                    Selection.ClearContents
            Range("K2:l10000").Select
                Range("l10000").Activate
                    Selection.ClearContents
            Range("AV2:AV10000").Select
                Range("AV10000").Activate
                    Selection.ClearContents
            Range("AX2:AX10000").Select
                Range("AX10000").Activate
                    Selection.ClearContents
            Range("AZ2:AZ10000").Select
                Range("AZ10000").Activate
                    Selection.ClearContents
            Range("BB2:BB10000").Select
                Range("BB10000").Activate
                    Selection.ClearContents
'
'
'   EXTENSION_SORT_BID_ITEM_GROUPED_1
Sheets("EXTENSION").Visible = True
Sheets("EXTENSION").Select
    Dim t As Range
    Dim s As Range
    Dim v As Range


'   Find "Name" in Row 1
    With Sheets("EXTENSION").Rows(1)
        Set t = .Find(InputBox("Enter 1st bid breakdown type:   Bid Item, Drawing, Area, Phase, or System"))
            If Not t Is Nothing Then
                Columns(t.Column).EntireColumn.Copy _
                    Destination:=Sheets("ACCUBID EXTENSION").Range("AA1")
                        Else: MsgBox "Title Not Found"
                            End If
                                End With
'   Find "Name" in Row 2
    With Sheets("EXTENSION").Rows(1)
        Set s = .Find(InputBox("Enter 2nd bid breakdown type, or hit OK"))
            If Not s Is Nothing Then
                Columns(s.Column).EntireColumn.Copy _
                    Destination:=Sheets("ACCUBID EXTENSION").Range("AB1")
                        Else: MsgBox "Title Not Found"
                            End If
                                End With
'   Find "Name" in Row 3
    With Sheets("EXTENSION").Rows(1)
        Set v = .Find(InputBox("Enter 3rd bid breakdown type, or hit OK"))
            If Not v Is Nothing Then
                Columns(v.Column).EntireColumn.Copy _
                    Destination:=Sheets("ACCUBID EXTENSION").Range("AC1")
                        Else: MsgBox "Title Not Found"
                            End If
                                End With
'
'
'   ITEM DESCRIPTION
Sheets("EXTENSION").Select
    Dim strColName1 As String
    Dim intRng1 As Integer
    Dim i As Integer
    Dim strVal1 As String
        intRng1 = 20  'To get the No. of Columns Available to Search
            strColName1 = "Item Description" 'To Get the Column Name to Search
                strSheetName = "Accubid Extension" 'To get the Sheet Name to paste the content
        For i = 1 To intRng1
'   Store the Cell Value
        strVal1 = Cells(1, i)
            'Check the Value with the User given column name
            If UCase(strVal1) = UCase(strColName1) Then
'   Select and Copy
        Cells(1, i).Select
            Range(Selection, Selection.End(xlDown).Offset(9997, 0)).Select
                Selection.Copy
'
'
'Select and Paste
        Sheets(strSheetName).Select
            Range("B1").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
        Next
'
'
'   QUANTITY
Sheets("EXTENSION").Select
    Dim strColName2 As String
    Dim intRng2 As Integer
    Dim J As Integer
    Dim strVal2 As String
        intRng2 = 20  'To get the No. of Columns Available to Search
            strColName2 = "Qty" 'To Get the Column Name to Search
                strSheetName = "Accubid Extension" 'To get the Sheet Name to paste the content
        For J = 1 To intRng2
'   Store the Cell Value
        strVal2 = Cells(1, J)
            'Check the Value with the User given column name
            If UCase(strVal2) = UCase(strColName2) Then
'   Select and Copy
        Cells(1, J).Select
            Range(Selection, Selection.End(xlDown).Offset(9997, 0)).Select
                Selection.Copy
'   Select and Paste
        Sheets(strSheetName).Select
            Range("C1").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
        Next
'
'
'   TOTAL MATERIAL
Sheets("EXTENSION").Select
    Dim strColName3 As String
    Dim intRng3 As Integer
    Dim k As Integer
    Dim strVal3 As String
        intRng3 = 20  'To get the No. of Columns Available to Search
            strColName3 = "Total Mat. $" 'To Get the Column Name to Search
                strSheetName = "Accubid Extension" 'To get the Sheet Name to paste the content
        For k = 1 To intRng3
'   Store the Cell Value
        strVal3 = Cells(1, k)
            'Check the Value with the User given column name
            If UCase(strVal3) = UCase(strColName3) Then
'   Select and Copy
        Cells(1, k).Select
            Range(Selection, Selection.End(xlDown).Offset(9997, 0)).Select
                Selection.Copy
'   Select and Paste
        Sheets(strSheetName).Select
            Range("D1").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
        Next
'
'
'   FIELD LABOR
Sheets("EXTENSION").Select
    Dim strColName4 As String
    Dim intRng4 As Integer
    Dim l As Integer
    Dim strVal4 As String
        intRng4 = 20  'To get the No. of Columns Available to Search
            strColName4 = "Total Field Labor" 'To Get the Column Name to Search
                strSheetName = "Accubid Extension" 'To get the Sheet Name to paste the content
        For l = 1 To intRng4
'   Store the Cell Value
        strVal4 = Cells(1, l)
            'Check the Value with the User given column name
            If UCase(strVal4) = UCase(strColName4) Then
'   Select and Copy
        Cells(1, l).Select
            Range(Selection, Selection.End(xlDown).Offset(9997, 0)).Select
                Selection.Copy
'   Select and Paste
        Sheets(strSheetName).Select
            Range("E1").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
        Next
'
'
'   VIEWPOINT CODES
Sheets("EXTENSION").Select
    Dim strColName5 As String
    Dim intRng5 As Integer
    Dim m As Integer
    Dim strVal5 As String
        intRng5 = 20  'To get the No. of Columns Available to Search
            strColName5 = "Viewpoint Codes" 'To Get the Column Name to Search
                strSheetName = "Accubid Extension" 'To get the Sheet Name to paste the content
        For m = 1 To intRng5
'   Store the Cell Value
        strVal5 = Cells(1, m)
            'Check the Value with the User given column name
            If UCase(strVal5) = UCase(strColName5) Then
'   Select and Copy
        Cells(1, m).Select
            Range(Selection, Selection.End(xlDown).Offset(9997, 0)).Select
                Selection.Copy
'   Select and Paste
        Sheets(strSheetName).Select
            Range("F1").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
        Next
'
'
'   EARNED VALUE
Sheets("EXTENSION").Select
    Dim strColName6 As String
    Dim intRng6 As Integer
    Dim N As Integer
    Dim strVal6 As String
        intRng6 = 20  'To get the No. of Columns Available to Search
            strColName6 = "Earned Value" 'To Get the Column Name to Search
                strSheetName = "Accubid Extension" 'To get the Sheet Name to paste the content
        For N = 1 To intRng6
'   Store the Cell Value
        strVal6 = Cells(1, N)
            'Check the Value with the User given column name
            If UCase(strVal6) = UCase(strColName6) Then
'   Select and Copy
        Cells(1, N).Select
            Range(Selection, Selection.End(xlDown).Offset(9997, 0)).Select
                Selection.Copy
'   Select and Paste
        Sheets(strSheetName).Select
            Range("G1").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
        Next
'
'
'THIS SLOWS THE SHEET DOWN
Application.Calculation = xlAutomatic
'
'
'
'   BREAKDOWN_SHEET_PASTE
Sheets("ACCUBID EXTENSION").Select
    ActiveSheet.Range("A1:A10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("x2"), Unique:=True
        Range("X3:X800").Select 'THIS WAS X4;X500
'
Sheets("ACCUBID EXTENSION").Select
    Range("X3:X800").Select
    ActiveWorkbook.Worksheets("ACCUBID EXTENSION").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ACCUBID EXTENSION").Sort.SortFields.Add Key:=Range _
        ("X3:X800"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ACCUBID EXTENSION").Sort
        .SetRange Range("X3:X800")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'
'
    Sheets("BID BREAKDOWN").Select
        ActiveSheet.Unprotect "PRECON"
    Sheets("Accubid Extension").Select
            Range("X4:X800").Select
                Selection.Copy
    Sheets("BID BREAKDOWN").Select
    Range("BM4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
'
'
'   SEPERATE CONCATENATED BID BREAKDOWN LABELS
Sheets("ACCUBID EXTENSION").Select
Range("X3:X800").Select
    Selection.TextToColumns Destination:=Range("AK2"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=True, Semicolon _
        :=False, Comma:=False, Space:=False, Other:=True, OtherChar:="*", _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True




' DELETE "||"
Sheets("ACCUBID EXTENSION").Select
Range("AK3:AM10000").Select


    Selection.Replace What:="|", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
'
'
'
'   BREAKDOWN #1_SHEET_PASTE
Sheets("ACCUBID EXTENSION").Select
    Range("AK3:AK799").Select
        Selection.Copy
Sheets("BID BREAKDOWN").Select
    Range("B4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
'
'
'   BREAKDOWN #2_SHEET_PASTE
Sheets("ACCUBID EXTENSION").Select
    Range("AL3:AL799").Select
        Selection.Copy
Sheets("BID BREAKDOWN").Select
    Range("C4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
'
'
''   BREAKDOWN #3_SHEET_PASTE
Sheets("ACCUBID EXTENSION").Select
    Range("AM3:AM799").Select
        Selection.Copy
Sheets("BID BREAKDOWN").Select
    Range("D4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
'
'
'
'


Sheets("EXTENSION").Select
    Range("A1").Select
'
'
'
Sheets("ACCUBID EXTENSION").Select
    ActiveSheet.Protect "PRECON"
'
'
'
Sheets("ACCUBID EXTENSION").Visible = False
Sheets("% LABOR CURVE").Visible = True
'
'
'
Sheets("PRODUCTIVITY").Select
    ActiveSheet.Unprotect "PRECON"
        ActiveSheet.Range("$HX$1:$HX$400").AutoFilter Field:=1
            ActiveSheet.Range("$HX$1:$HX$400").AutoFilter Field:=1, Criteria1:="1"
    Dim vWs As Worksheet
    Set vWs = Application.ActiveSheet
    Dim vPws As String
    vPws = "PRECON"
        vWs.Protect Password:=vPws, userinterfaceonly:=True
            vWs.EnableOutlining = True
                Range("A1").Select
'
'
'
Sheets("RECAP").Select
'
'
'
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
'
'
'
End Sub

Display More

Smallman · Dec 20th 2017

Hi

If you remove the clear contents lines and replace them with this – you save 27 lines of code.

Code

Range("B2:G10000, K2:l10000, X2:AD10000, AT2:AQ10000, AV2:AV10000, AZ2:AZ10000, BB2:BB10000").ClearContents

If you post your workbook I will make your code clean. A significant change would be to have 3 cells called

bid breakdown type 1
bid breakdown type 2
bid breakdown type 3

In these cells you would type your bid criteria – I never use input boxes in code as it stops the code where the method above will not.

Hopefully we will see your file soon if not email it to me directly.

Take care

Smallman

jolivanes · Dec 21st 2017

Surprise, surprise.
Mr, I assume it is Mr, Smallman did not question why it has, on multiple occasions

Code

Range("B2:G10000").Select

I mean the 10000 and the .Select is a given.

Just joking here but admiring your willingness to wade through all of the code.

Merry Christmas and a Happy and Prosperous New Year.

Smallman · Dec 21st 2017

LOL - yes you know how I think...... I was going to say something about the selection but it was mostly recorded code and I figured the final version would have spelt that out. I wanted to get rid of the sheet references mainly and needed the file to nail that down. Up to the Op from here. At this time of year I am time rich and love to roll back the clock and do this sort of thing once more. Take it easy jolivanes!!!!!

Mr Smallman

punchinpaper · Dec 21st 2017

Jolivanes, Smallman,
I am learning this all through trial and error and I built this workbook from scratch in order to organize our bids. Clearly I know very little about proper coding, hence the reason for the post. I have the workbook functioning as I would like it to function but now I am trying to get it cleaned up. This thing quickly got out of my control.
I have a link posted to the workbook file location below (BID WORKBOOK v.6.30beta) and in the link are a few samples of how the workbook operates. The workbook is password protected (just to keep folks from corrupting date while using it.) You can unlock it by hitting CTRL/END on the recap page, that will take yo to the unlock button.

Please let me know if you can help clean this up to function quicker and if you are willing to clean up the entire workbook please PM me with a fee with which you would ask to do so as I now realize that this may be a bigger job than I thought.
Thank you for your assistance.

https://www.dropbox.com/sh/gix7eot4a...yUSDJ14xa?dl=0

punchinpaper · Dec 21st 2017

Quote from Smallman
Hi

If you remove the clear contents lines and replace them with this – you save 27 lines of code.
Code
Range("B2:G10000, K2:l10000, X2:AD10000, AT2:AQ10000, AV2:AV10000, AZ2:AZ10000, BB2:BB10000").ClearContents
If you post your workbook I will make your code clean. A significant change would be to have 3 cells called

bid breakdown type 1
bid breakdown type 2
bid breakdown type 3

In these cells you would type your bid criteria – I never use input boxes in code as it stops the code where the method above will not.

Hopefully we will see your file soon if not email it to me directly.

Take care

Smallman
Display More

I would love to eliminate input boxes. The workbook needs to have user selectable options in the three pop ups of: "Bid Item, Drawing, Area, Phase, System, of Viewpoint Codes" the only other way I could think of to do that would be a user check box located on the RECAP page where they check the selection of how the bid should be broken down. I just didnt know how to set that up.

The individual code ranges were entered that way because there is content in other cells that I did not want to remove.

jolivanes · Dec 21st 2017

There was no negative intentions in my thread. Just a little dig at Smallman. It is holiday season after all. I don't subscribe to being politically correct so we'll just go from there.
It is commendable what you are doing so just keep it up.
A small example on where to clean the code.
Avoid using select.

This

Code

Sheets("ACCUBID EXTENSION").Select
    Range("AL3:AL799").Select
        Selection.Copy
Sheets("BID BREAKDOWN").Select
    Range("C4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

could be changed to something like this

Code

With Sheets("ACCUBID EXTENSION").Range("AL3:AL799")    '<----- Why 799?
    .Copy Sheets("BID BREAKDOWN").Range("C4")
End With

But Smallman will get you on the right track.

punchinpaper · Dec 21st 2017

Jolivanes
I didnt take it as a negative comment, no worries.
I expected a little bashing after all since I am sure what I did is super sloppy at best.

You say don't use select??? I wont ask why not but I will say I did that an awful lot. oh boy. At least this will be the holiday gift that keeps on giving. lol
That's a nice option, thanks

799 is because where it is pasted has a line limit.

jolivanes · Dec 21st 2017

While Smallman is sweating away, one other little comment.
At the beginning of the code, Application.ScreenUpdating, as well as the others, should be set to False and at the end to True (as you have it here) again.

punchinpaper · Dec 21st 2017

Quote from jolivanes

While Smallman is sweating away, one other little comment.
At the beginning of the code, Application.ScreenUpdating, as well as the others, should be set to False and at the end to True (as you have it here) again.

So I knew about that one but I have something dirty in the other codes that tends to hang up occasionally and the patch was to add that as a "lets just start fresh shall we' bit.
Thanks for the comments, I glad to have the input.

jolivanes · Dec 21st 2017

Maybe I explained it wrong. At the beginning you have it as "True" instead of "False".
I see, a few lines down it is set at "False"

punchinpaper · Dec 21st 2017

Quote from jolivanes

Maybe I explained it wrong. At the beginning you have it as "True" instead of "False".
I see, a few lines down it is set at "False"

I see what you are saying. I added it then added it again in the inverse. I will fix that.

Smallman · Dec 21st 2017

LOL - "while Smallman is sweating away". Yesterday I posted a few times on Ozgrid and then I went to the pub - the perfect day!!!! I am planning on repeating the dose today so this is my first look at your problem in 24 hours. And I would suggest I will be heading out to knock the top off a cold Christmas beer very shortly. It is early here in Oz but somewhere in the world it is 5pm. Bottoms up guys!!!!!

Smallman

punchinpaper · Dec 21st 2017

Cheers

jolivanes · Dec 22nd 2017

Enjoy as much and as long as you can.
Say hello to some of the better looking sheilas for me.

Code clean up help

Participate now!

Share

Users Viewing This Thread