Posts by Shaner73

Shaner73 · May 26th 2016

Re: Copy and Past Row based on criteria??

That worked!!! Thank you so much. I really appreciate your help!

Shaner73 · May 26th 2016

Re: Copy and Past Row based on criteria??

As soon as I enter data into H2 and tab over, the Error pops up. In O2, the formula does NOT appear to complete. The cell contains #DIV/0!. I have attached a pic.

Shaner73 · May 26th 2016

Re: Copy and Past Row based on criteria??

This info?

Run-time error '13':
Type mismatch

Shaner73 · May 26th 2016

Re: Copy and Past Row based on criteria??

Thank you skywriter...

I'm getting an error and the debug goes to this...

Code

If Me.ListObjects("InvTracker").DataBodyRange(Target.Row - 1, 15).Value = "Yes" Then

Shaner73 · May 25th 2016

Re: Copy and Past Row based on criteria??

The data is actually there...most of the cells are drop-downs. The only information a person will be actually typing is the Date and the Consumed Qty. Everything else is picking from the drop-down or the Macro will be auto-populating the other cells.

The trigger will be when whatever cell in Column "O" becomes "Yes", then it will just copy and paste the cells from Columns F and G of the current Row into the "Order" sheet....(make sense?)

I have attached a new version on the workbook as I've changed a couple things in the formulas. If you enter 3500 into "H2", this will cause O2 to be "Yes".

Shaner73 · May 25th 2016

Re: Copy and Past Row based on criteria??

Quote from skywriter;771399

But in your original post you mentioned down to 500.

So F2 gets copied if O2 is yes and F3 gets copied if O3 is yes, or
F2 and F3 if O2 is yes, I'm confused?

I did post that I had a typo...my brain was toast yesterday. Again, my apologies.

The cells to be copied are F2 and G2 IF O2 is "Yes". And this will continue as Rows are populated down to Row 500.

Shaner73 · May 25th 2016

Re: Copy and Past Row based on criteria??

Sorry...I just noticed my typo...it should be cells F2 and G2. My apologies

Shaner73 · May 25th 2016

Re: Copy and Past Row based on criteria??

Quote from skywriter;771329

Why 2 cells F2 and F3, what's the logic? - Because this is the only data I need copied.

What do you mean based on column O, do you mean based on O2 and O3 since your request is for F2 and F3 being copied. - It would be based on cell O2 for the data to be copied.

Why does it matter if O has conditional formatting, if we are looking for a yes? - I just wanted to be thorough in the info I gave. Not only is there a Conditional Format, there is also a Formula.

Answered your questions.

I don't have a lot of experience with VBA...mostly very basic things.

Shaner73 · May 24th 2016

I've tried several ways to do this, and have Google searched for a couple days, but still coming up empty.

I'm needing to copy cells "F2" and "F3" from Sheet "InvTraker", then pasted into cells "A2" and "B2" into sheet "Order", based on Column "O" being "Yes". However, Column "O" is a formula with a Conditional Format via a macro. This will need to continue all the way down the sheet (row 500)...which may change.

I have attached the workbook for reference.

forum.ozgrid.com/index.php?attachment/69224/

Shaner73 · May 23rd 2011

Re: Converting macro built in '07 to use in '03...

Thank you cytop. I made some adjustments and the work great. Now, I will have to get on another PC to work with 2003 and step through the code.

If anyone else has some advice or direction, I'm all ears...well, eyes.

Shaner73 · May 20th 2011

I know there are compatibility issues between Excel 2003 and 2007. So, I'm pretty sure I already know my answer, but I need to ask so I can rest easy.

A co-worker built a macro in 2007. However, a majority of my company does not have 2007, only 2003. These people need this macro loaded on their PC, but the macro doesn't work on 2003.

Is there an easy "fix", or does the code need to be re-written in 2003?

Here's the code: (suggestions on making this run faster and more efficient are welcome)

Code

Sub EMS_Match_Report1()
'
' Macro1 Macro
'


'
    Application.ScreenUpdating = False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:M").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=3
    Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft
    Columns("P:Q").Select
    Columns("Q:U").Select
    Selection.Delete Shift:=xlToLeft
    Columns("U:U").Select
    ActiveWindow.SmallScroll ToRight:=7
    Columns("Y:Y").Select
    ActiveWindow.SmallScroll ToRight:=10
    Columns("Y:AH").Select
    Selection.Delete Shift:=xlToLeft
    Columns("Z:Z").Select
    ActiveWindow.SmallScroll ToRight:=18
    Columns("Z:AM").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-21
    Columns("D:D").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("O:O").Select
    Selection.Cut
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Columns("Q:Q").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight
    Columns("O:O").Select
    Selection.Cut
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    Columns("Q:Q").Select
    Selection.Cut
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("M:M").Select
    Selection.Insert Shift:=xlToRight
    Columns("N:O").Select
    Selection.Cut
    Columns("S:S").Select
    Selection.Insert Shift:=xlToRight
    Columns("Y:Y").Select
    Selection.Cut
    Columns("U:U").Select
    Selection.Insert Shift:=xlToRight
    ActiveWindow.SmallScroll ToRight:=-12
    Range("A1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.RowHeight = 119.25
    Cells.Select
    Selection.ColumnWidth = 34
    Cells.EntireColumn.AutoFit
    Cells.EntireColumn.AutoFit
    Columns("A:A").Select
    Selection.ColumnWidth = 18.43
    Columns("A:A").EntireColumn.AutoFit
    Columns("F:M").Select
    Selection.ColumnWidth = 7
    Selection.ColumnWidth = 5.71
    Columns("F:M").EntireColumn.AutoFit
    Columns("N:R").Select
    Selection.ColumnWidth = 5
    Columns("N:R").EntireColumn.AutoFit
    Columns("S:Y").Select
    Columns("S:Y").EntireColumn.AutoFit
    Selection.ColumnWidth = 7.14
    Columns("S:Y").EntireColumn.AutoFit
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Fran $"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("R2").Select
    Columns("R:R").ColumnWidth = 5
    Columns("R:R").EntireColumn.AutoFit
    ActiveWindow.SmallScroll ToRight:=-14
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Mfr Part Number (from Oppslist)"
    With ActiveCell.Characters(Start:=1, Length:=31).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Cells.Select
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
        "B2:B4877"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A1:CF4877")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
' Delete_Blank_Row_Test Macro
    'Columns("B:B").Select
    'Selection.SpecialCells(xlCellTypeBlanks).Select
    'Selection.EntireRow.Delete
    'Range("A2").Select
' Delete_Dups_Test Macro
    ActiveSheet.Range("$A$1:$CF$4877").RemoveDuplicates Columns:=Array(1, 19, 20, 23 _
        ), Header:=xlNo
' Sort Macro
    Cells.Select
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
        "A2:A18594"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A1:CF18594")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
' Start Blank IPN Cells Macro
    Columns("C:C").Select
    Selection.Replace What:="", Replacement:="blank", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A2").Select
' End Blank IPN Cell Macro
' Numbering
    Application.DisplayAlerts = False
    Columns("A:A").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$65000").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B2").Select
    'Range("A2").Select
        'Columns("B:B").Select
    'Range("B2").Activate
    'Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    'Range("B1").Select
    'ActiveCell.FormulaR1C1 = "CT"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("B3").Select
  If IsEmpty(ActiveCell) Then Exit Sub
  Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown
'VLookUp Part
    Sheets(2).Select
    Sheets(2).Name = "Numbers"
    Sheets(1).Select
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Numbers!C[-1]:C,2,FALSE)"
    If IsEmpty(ActiveCell) Then Exit Sub
  Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown
'Start Copy Paste Special
  Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
  'Stop Copy Paste Special
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "#"
    With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Columns("B:B").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Columns("B:B").Select
    Selection.Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Columns("A:A").EntireColumn.AutoFit
    Range("A2").Select
    Sheets("Numbers").Select
    ActiveWindow.SelectedSheets.Delete
' Border_and_Coloring_Formatting Macro
    Range("A:B,D:F").Select
    Range("D1").Activate
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(D1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10092543
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Columns("G:N").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(G1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Columns("O:S").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(O1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Columns("C:C").Select
    Range("C:C,T:Z").Select
    Range("T1").Activate
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(T1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Range("A2").Select
' Copy Worksheets and Renaming
    Range("A2").Select
    Sheets(1).Select
    Sheets(1).Copy After:=Sheets(1)
    Sheets(2).Select
    Sheets(2).Copy After:=Sheets(2)
    Sheets(3).Select
    Sheets(3).Name = "Pivot Table"
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:R").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    Sheets(2).Select
    Sheets(2).Name = "Detailed Match"
    Sheets(1).Select
    Sheets(1).Name = "Match Summary"
    Sheets("Match Summary").Select
    With ActiveWorkbook.Sheets("Match Summary").Tab
        .Color = 255
        .TintAndShade = 0
    End With
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("S:S").Select
    Columns("S:Z").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    Application.ScreenUpdating = True
' Removes Dups in Col A in Match Summary Sheet
    Sheets("Match Summary").Select
    Columns("A:R").Select
    ActiveSheet.Range("$A$1:$R$65000").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A2").Select
' Subtotal Average on Detailed Match Sheet
    Sheets("Detailed Match").Select
    Selection.Copy
    Range("A2").Select
    Application.CutCopyMode = False
    Columns("A:U").Select
    Selection.Subtotal GroupBy:=2, Function:=xlAverage, TotalList:=Array(5, 6) _
        , Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Columns("B:B").Select
    Selection.Replace What:=" AVerage", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Sheets("Match Summary").Select
    'Columns("S:S").Select
    'Selection.Delete Shift:=xlToLeft
    Range("A2").Select
' Pivot Table 1
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Pivot Table!R1C1:R1048576C3", Version:=xlPivotTableVersion12). _
        CreatePivotTable TableDestination:="", TableName:="PivotTable1" _
        , DefaultVersion:=xlPivotTableVersion12
    With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "MPN (from Your Customer List)")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Listed Qty"), "Count of Listed Qty", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Listed Qty")
        .Caption = "Sum of Total Listed Avail. Qty"
        .Function = xlSum
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Listed Cost"), "Count of Listed Cost", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Listed Cost")
        .Caption = "Min of Listed Cost"
        .Function = xlMin
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Listed Cost"), "Count of Listed Cost", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Listed Cost")
        .Caption = "Max of Listed Cost"
        .Function = xlMax
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
    Columns("A:D").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("A:D").Select
    Selection.Copy
    Sheets("Match Summary").Select
    Columns("S:S").Select
    ActiveSheet.Paste
    Sheets(1).Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Sheets("Pivot Table").Select
    Columns("B:C").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
'Delete Dups in Pivot Table
    Sheets("Pivot Table").Select
    Columns("A:C").Select
    ActiveSheet.Range("$A$1:$C$65000").RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlNo
' Pivot Table 2
   ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Pivot Table!R1C1:R1048576C3", Version:=xlPivotTableVersion12). _
        CreatePivotTable TableDestination:="", TableName:="PivotTable1" _
        , DefaultVersion:=xlPivotTableVersion12
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "MPN (from Your Customer List)")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("A2E Contact")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("File#"), "Count of File#", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
'Begin Test PT Macro
    With ActiveSheet.PivotTables("Pivottable1")
        .ColumnGrand = False
        .DisplayNullString = True
        .RowGrand = False
    End With
    With ActiveSheet.PivotTables("Pivottable1").PivotFields( _
        "MPN (from Your Customer List)")
        .PivotItems("(blank)").Visible = False
    End With
'End Test PT Macro
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Match Summary").Select
    Range("W1").Select
    ActiveSheet.Paste
    Sheets(3).Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Sheets("Match Summary").Select
' Formatting_After_PT Macro
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Columns("S:S").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=7
    Columns("V:V").Select
    Selection.ClearContents
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "Total Excess / LDT Reps Showing Avail"
    Range("S1:V1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("S:S").ColumnWidth = 6.71
    Columns("T:V").Select
    Selection.ColumnWidth = 5.43
    Columns("T:U").Select
    Columns("T:U").EntireColumn.AutoFit
    Selection.ColumnWidth = 5.29
    Range("V1").Select
    Columns("V:V").ColumnWidth = 8.43
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Res. Qty"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("A2").Select
' Pt Formatting 2
    Range("W1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    ActiveWindow.SmallScroll ToRight:=-15
    Columns("W:W").Select
    Range(Selection, Selection.End(xlToRight)).Select
   'Columns("W:DZ").EntireColumn.AutoFit
    Columns.EntireColumn.AutoFit
    ActiveWindow.SmallScroll ToRight:=-18
' Delete Pivot Table Sheet Macro
    Sheets("Pivot Table").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Match Summary").Select
    Range("A2").Select
    Application.DisplayAlerts = True
' Macro2 Macro
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("S1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
' Macro1 Macro
    Sheets("Detailed Match").Select
    Columns("B:B").Select
    Selection.Replace What:="Grand", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    ActiveWorkbook.Save
' Format Detail Match Sheet
    Range("A:A,D:D").Select
    Application.ScreenUpdating = False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Range("A1").Select
' Start IPN Macro
    Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10092543
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("D:D").Select
    Selection.Replace What:="blank", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'Stop IPN Macro
    'Application.ScreenUpdating = True
    Range("C:C,G:Z").Select
    Range("G1").Activate
    Selection.Replace What:="", Replacement:="blank", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.SmallScroll ToRight:=-2
    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("G1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("N1").Select
    ActiveWindow.SmallScroll ToRight:=-5
    Range("G1:N1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("O1:S1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("T1:Z1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("C:C,G:Z").Select
    Range("G1").Activate
    Selection.Replace What:="blank", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("G:N").Select
    Selection.Columns.Group
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Range("A3").Select
    Sheets(2).Select
    Sheets(2).Name = "Detailed Match"
    Sheets("Match Summary").Select
    Columns("F:M").Select
    Selection.Columns.Group
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    ActiveWorkbook.Save
    Sheets(1).Select
    Sheets(1).Name = "Match Summary"
    Range("B2").Select
    Columns("W:W").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Replace What:="", Replacement:="+", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("W1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Selection.Replace What:="+", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Sheets("Detailed Match").Select
    Columns("C:D").Select
    Selection.Columns.Group
    Columns("X:X").Select
    Sheets("Match Summary").Select
    Columns("C:C").Select
    Selection.Columns.Group
    Sheets("Detailed Match").Select
    Range("A3").Select
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
    Sheets("Match Summary").Select
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
    Range("B2").Select
' Start IPN Macro
    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10092543
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("C:C").Select
    Selection.Replace What:="blank", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
' Count Macro
    Columns("W:W").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Replace What:="", Replacement:="+", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("V2").Select
    ActiveCell.FormulaR1C1 = "=COUNT(RC[1]:RC[500])"
    If IsEmpty(ActiveCell) Then Exit Sub
    Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown
    Columns("W:W").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Replace What:="+", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("V2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A2").Select
' Delete EMS/OEM Name Column Macro
    Sheets("Detailed Match").Select
    Columns("X:X").Select
    Selection.Delete Shift:=xlToLeft
    Range("B9").Select
    Sheets("Match Summary").Select
    Range("B2").Select
    Application.ScreenUpdating = True
End Sub

Display More

Shaner73 · Aug 18th 2010

Re: Speed up and Refine Macro

Well, everything seems to be a big mess now. I'm not sure what happened. Back to the drawing board I guess.

The info in Col. A is now gone
The info to be pulled from Col. A and put into columns N, S and T is not there.

I was going to attach the current codes, but 5 of them are too large.

Thanks for the help anyway.

Shaner73 · Aug 17th 2010

Re: Speed up and Refine Macro

Ok, let me work on this and see what I can get to work, or not work. I really appreciate all of your help.

And you're correct, I am no comfortable with VBA. But I will be one of these days.

Shaner73 · Aug 17th 2010

Re: Speed up and Refine Macro

Thanks Demgar. Where exactly do I put the ' application.calculateFull ' ? I'm not sure where you are telling me.

Shaner73 · Aug 17th 2010

Re: Speed up and Refine Macro

[ATTACH=CONFIG]32926[/ATTACH]Thanks shg. But now I'm getting another error...

Shaner73 · Aug 17th 2010

Re: Speed up and Refine Macro

Bumping for more help and/or advice please.

Shaner73 · Aug 17th 2010

Re: Slow Macro / Macro goes to last row in sheet, not to the end of data

Thank you for the quick response. But, I am now getting an error...

Code

Sub A()
'
' A Macro
'


Dim my_range As Range
[COLOR=Yellow]Set my_range = UsedRange.Columns("a")   [COLOR=Black]This is highlighted in YELLOW[/COLOR]
[/COLOR]
' Application.ScreenUpdating = False


    my_range.Replace What:="650-0373 REV 03 , SPN / AM29LV065DU90REF*", Replacement:="AM29LV065DU90REF", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    my_range.Replace What:="650-0374 REV 02, XC95144XL-7TQG100C", Replacement:="XC95144XL-7TQG100C", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    my_range.Replace What:="650-0392 REV02,MP:RBAKCF256JI DC>060810*", Replacement:="RBAKCF256JI", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Display More

Shaner73 · Aug 17th 2010

Re: Slow Macro / Macro goes to last row in sheet, not to the end of data

Fifth process....the Second-Forth process are virtually the same....just different "rules".

Code

[FONT=Arial][size=10][COLOR=#000000]Sub E()
'
 E Macro
'
' Keyboard Shortcut: Ctrl+t
'


        Columns("D:D").Select


    Selection.Replace What:="ADVANCED MICRO*", Replacement:="AMD", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="AMD DEV*", Replacement:="AMD", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="FUTURE ELEC*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        


'Location to A2 Code()


        Columns("L:L").Select


    Selection.Replace What:="Bangalore (390)", Replacement:="ZIN06", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Pecs (431)", Replacement:="ZHU01", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
'MFR()
'
        
'LocCodetoVendorNumber()




' Copy_and_Paste_Special_Col_L_as_Values
'
    Columns("L:L").Select
    Selection.Copy
    Range("L1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'
' Copy & Pastes Col. L to Col. M
'
    Columns("L:L").Select
    Selection.Copy
    Range("M1").Select
    ActiveSheet.Paste
    Range("M1").Select
    


' Copy_and_Paste_Special_Values Macro
' Macro recorded 7/10/2008 by abunch
    Columns("M:M").Select
    Selection.Copy
    Range("M1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'*******************************************
'*******************************************
'*    Loc Code to Vendor# Conversion       *
'*                                         *
'*******************************************
'*******************************************
      Columns("M:M").Select


    Selection.Replace What:="~ZIN06", Replacement:="41949", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
' Remove_Scientific_Notation Macro
'
    Columns("L:L").Select
    Selection.NumberFormat = "0000"
        
        
'VendorNumbertoCustomerNUmber()




' Copy_and_Paste_Special_Col_M_as_Values
'
    Columns("M:M").Select
    Selection.Copy
    Range("M1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'
' Copy & Pastes Col. M to Col. P
'
    Columns("M:M").Select
    Selection.Copy
    Range("P1").Select
    ActiveSheet.Paste
    Range("P1").Select
    


' Copy_and_Paste_Special_Values Macro
' Macro recorded 7/12/2010 by Shane Fiscel
    Columns("P:P").Select
    Selection.Copy
    Range("P1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




'*******************************************
'*******************************************
'*    Vendor # to Customer# Conversion     *
'*                                         *
'*******************************************
'*******************************************
      Columns("P:P").Select
      
    Selection.Replace What:="38045", Replacement:="12", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="37397", Replacement:="20", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False


' Copy_and_Paste_Special_Col_Q_as_Values
'
    Columns("Q:Q").Select
    Selection.Copy
    Range("Q1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'
' Copy & Pastes Col. M to Col. Q
'
    Columns("M:M").Select
    Selection.Copy
    Range("Q1").Select
    ActiveSheet.Paste
    Range("Q1").Select
    


' Copy_and_Paste_Special_Values Macro
' Macro recorded 7/12/2010 by Shane Fiscel
    Columns("Q:Q").Select
    Selection.Copy
    Range("Q1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




'*****
'*****
'*    Vendor # to Customer# Conversion     *
'*                                         *
'*****
'*****
      Columns("Q:Q").Select
      
    Selection.Replace What:="38045", Replacement:="600652", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="37397", Replacement:="845", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False




' Remove_Scientific_Notation Macro
'
    Columns("P:Q").Select
    Selection.NumberFormat = "00"




' Blank Macro
'


'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Copy
    Range("B2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(RC[-1],""""),7,""okay"")"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B65536")
    Range("B2:B65536").Select
    ActiveWindow.SmallScroll Down:=29
    Rows("4:4").Select
    Selection.Cut
    Range("B31").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(RC[-1],""""),7,""okay"")"
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeFormulas, 23).Select
    Selection.SpecialCells(xlCellTypeFormulas, 1).Select
    ActiveWindow.SmallScroll Down:=10
    Selection.EntireRow.Delete
    Range("A1").Select
    Columns("B:B").Select
    ActiveCell.FormulaR1C1 = ""
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select


End Sub

Display More

[/COLOR][/SIZE][/FONT]

Shaner73 · Aug 17th 2010

Re: Slow Macro / Macro goes to last row in sheet, not to the end of data

Second process continued...

Code

[FONT=Arial][size=10][COLOR=#000000]' Final Formatting
' Macro recorded 5/29/2009 by abunch
'
    Columns("CZ:DG").Select
    Range("DG1").Activate
    Selection.Interior.ColorIndex = 6
    Range("DA19").Select
    Range("DA1").Select
    Range("CZ1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("CZ1").Select
    ActiveCell.FormulaR1C1 = "Finalized MPN"
    Range("DA1").Select
    ActiveCell.FormulaR1C1 = "Filtered MPN"
    Range("DA1").Select
    Selection.Font.ColorIndex = 3
    Range("DA1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 3
    End With
    Range("DB1").Select
    Selection.ClearContents
    Range("DB1").Select
    ActiveCell.FormulaR1C1 = "Finalized Part Numbers"
    Range("DB1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("DB1").Select
    Selection.Font.ColorIndex = 3
    Range("DC1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Font.ColorIndex = 3
    ActiveCell.FormulaR1C1 = "Filtered Part Numbers"
    Range("DD1").Select
    ActiveCell.FormulaR1C1 = "1st Rem'vd Suffixes"
    Range("DD1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Font.ColorIndex = 3
    Selection.Font.Bold = True
    Columns("DD:DD").ColumnWidth = 25.14
    Range("DE1").Select
    ActiveCell.FormulaR1C1 = "2nd Rem'vd Suffixes"
    Range("DE1").Select
    Selection.Font.Bold = True
    Selection.Font.ColorIndex = 3
    Columns("DE:DE").ColumnWidth = 20.57
    Range("DE1").Select
    Selection.Copy
    Application.CutCopyMode = False
    Range("DF1").Select
    ActiveCell.FormulaR1C1 = "3rd Rem'vd Suffixes"
    Range("DF1").Select
    Selection.Font.ColorIndex = 3
    Selection.Font.Bold = True
    Columns("DF:DF").ColumnWidth = 18.14
    Columns("DG:DG").ColumnWidth = 12.57
    Columns("DG:DG").ColumnWidth = 18.14
    Range("DG1").Select
    Selection.Font.Bold = True
    Selection.Font.ColorIndex = 3
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 3
    End With
    Range("DG1").Select
    ActiveCell.FormulaR1C1 = "Protected Part #s"
    Range("DG2").Select
    Columns("DG:DG").ColumnWidth = 20
    Range("DG1").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "MPN"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Part Notes"
    Range("N2").Select
    Columns("N:N").ColumnWidth = 19.71
    
' Format_Col_A_left_Sort_Col_N_decreasing
' Macro recorded 6/1/2009 by abunch
'
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Select
    Selection.Sort Key1:=Range("N2"), Order1:=xlDescending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A2").Select
    Range("A2:O65536").Sort Key1:=Range("N2"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    Range("A1").Select
    
    
    
'Problem: activate these to see the Cols. before they're removed
'End Sub
'Sub Remove_scratch_pad_Cols()




'
' Remove_scratch_pad_Cols Macro
' Macro recorded 5/29/2009 by abunch
'
    Columns("CY:CY").Select
    Columns("CY:DH").Select
    Selection.Delete Shift:=xlToLeft
    Range("DB17").Select
    Range("A1").Select
    
'Empty Cell Delete


' Blank Macro
'
'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Copy
    Range("B2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(RC[-1],""""),7,""okay"")"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B65536")
    Range("B2:B65536").Select
    ActiveWindow.SmallScroll Down:=29
    Rows("4:4").Select
    Selection.Cut
    Range("B31").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(RC[-1],""""),7,""okay"")"
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeFormulas, 23).Select
    Selection.SpecialCells(xlCellTypeFormulas, 1).Select
    ActiveWindow.SmallScroll Down:=10
    Selection.EntireRow.Delete
    Range("A1").Select
    Columns("B:B").Select
    ActiveCell.FormulaR1C1 = ""
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select


'*****************************************
'*****************************************


'DESCRIPTIONS:


'Col.CZ "Finalized MPN"
'=IF(DG2<>"",DG2,IF(DA2="","",DA2))
'Creates the Finalized MPN by checking for any protected MPNs in
'Col. DG and added them back in ("REV" prefixes)




'Col.Db "Finalized Part Numbers"
'=IF(DG2<>"","",DC2)
'If there is NOT a "REV" prefix protected in Col. DG, puts a blank,
'ELSE the Filtered Part Number




'Col.DC "Filtered Part Numbers"
'=CONCATENATE(DD2,DE2,DF2)
'The "Rel" suffix in Find/Replace removes itself to become a "2nd
'Rem'vd Suffixes", this puts them back together,
'up to 3 divided removed suffixes.




'Col.DG "Protected Part #s"
'=IF(MID(A2,1,3)="REV",A2,"")
'This detects the first 3 letters of a MPN to find any starting
'with "REV", and MOVES them to Col. DG for "Protection" (otherwise
'the formulas would erase the ENTIRE MPN!).  If any MPN is in here,
'it will be put in the "Finalized MPN" in Col. CZ, which will be
'copied back to Col. A.


End Sub

Display More

[/COLOR][/SIZE][/FONT]

Shaner73 · Aug 17th 2010

Re: Slow Macro / Macro goes to last row in sheet, not to the end of data

Second process...this will take two posts...

Code

Sub B()'' B Macro' Macro recorded 6/28/2010''Moves_Col_A_Temporarily_to_Col_CZ_to_work_on    Columns("A:A").Select    Selection.Copy    Range("CZ1").Select    ActiveSheet.Paste        Columns("CZ:CZ").Select           '*** FIND AND REMOVE SUFFIXES ***'*********************************************'*** MACRO STARTS AGAIN FURTHER BELOW ***'************************************************************'ITEMS TO REMOVE FROM ORIGINAL'***  REV SUFFIX BEGINS ***    Selection.Replace What:=" (3649898)**", Replacement:="~(3649898)*", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:=" (AKA 108613258)*", Replacement:="~(AKA 108613258)", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:=" (AMK DIE0.11)*", Replacement:="~(AMK DIE0.11)", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:=" (B) TYPE*", Replacement:="~(B) TYPE", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:=" (B88069X1630T602)*", Replacement:="~(B88069X1630T602)", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="W/TRIMMED LEAD*", Replacement:="~TRIMMED LEADS", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="White*", Replacement:="~White", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False    Selection.Replace What:="Yellow*", Replacement:="~Yellow", LookAt:=xlPart, _        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _        ReplaceFormat:=False        '***  REV SUFFIX ENDS ***'*** MACRO CONTINUES  ***'**********************************'Separates the suffixes from the MPN    Application.CutCopyMode = False    Selection.TextToColumns Destination:=Range("CZ1"), DataType:=xlDelimited, _        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _        :="~", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True ' Insert_Col_DA' Macro recorded 5/29/2009 by abunch'    Columns("DA:DA").Select    Selection.Insert Shift:=xlToRight '' Format_Col_DA_to_General' Macro recorded 5/29/2009 by abunch'    Columns("DA:DA").Select    Selection.NumberFormat = "General"  '' Concatenate_Formula' Macro recorded 5/29/2009 by abunch'    Range("DA2").Select'Formula: =CONCATENATE(DD2,DE2,DF2)    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[1],RC[2],RC[3])"    Range("DA2").Select  'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxIf IsEmpty(ActiveCell) Then Exit Sub  Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown    Range("da2").Select      'Insert_Column_CZ_to_KEEP_"REV"_Prefixes    Columns("CZ:CZ").Select    Selection.Insert Shift:=xlToRight    With Selection        .HorizontalAlignment = xlLeft        .VerticalAlignment = xlBottom        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    'Insert_Column_DB_to_KEEP_"REV"_Prefixes    Columns("DB:DB").Select    Selection.Insert Shift:=xlToRight    With Selection        .HorizontalAlignment = xlLeft        .VerticalAlignment = xlBottom        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With    'Formula in CZ2: =IF(DG2<>"",DG2,IF(DA2="","",DA2))    Range("CZ2").Select    ActiveCell.FormulaR1C1 = "=IF(RC[7]<>"""",RC[7],IF(RC[1]="""","""",RC[1]))"      'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx  Range("CZ2").Select  If IsEmpty(ActiveCell) Then Exit Sub  Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown    Range("cz2").Select    'Formula in DB2: =IF(DG2<>"","",DC2)    Columns("DB:DB").Select    Application.CutCopyMode = False    'Change Col DB to General formatting    Selection.NumberFormat = "General"        Range("DB2").Select    ActiveCell.FormulaR1C1 = "=IF(RC[5]<>"""","""",RC[1])"    Range("DB2").Select    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx  If IsEmpty(ActiveCell) Then Exit Sub  Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown    Range("db2").Select        'Formula in DG2: =IF(MID(A2,1,3)="REV",A2,"")'(Formula checks to see if the first 3 letters are "REV")    Range("DG2").Select    ActiveCell.FormulaR1C1 = "=IF(MID(RC[-110],1,3)=""REV"",RC[-110],"""")"    Range("DG2").Select    Selection.Copy    Range("DG3").Select    Range("DG3").Select    ActiveSheet.Paste    Application.CutCopyMode = False    Range("DG1").Select    Range("CZ1").Select    ActiveCell.FormulaR1C1 = "=RC[1]"    Range("CZ2").Select    Columns("CZ:CZ").Select    Selection.Copy    Range("A1").Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Columns("DB:DB").Select    Application.CutCopyMode = False    Selection.Copy    Application.CutCopyMode = False    Range("DB1").Select    ActiveCell.FormulaR1C1 = "=RC[-95]"    Columns("DB:DB").Select    Selection.Copy    Range("N1").Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _         :=False, Transpose:=False