Sub Main_Macro()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Call Setup_Pricing_Detail_Sheet
Call Delete_Rows_With_Parts_No_Longer_Ordered
Call Change_Part_Numbers
Call Copy_Data_From_Pricing_Detail_to_MAPICS_Order
Sheets("Pricing Detail Dummy").Delete
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Sub Setup_Pricing_Detail_Sheet()
Dim rng As Range, ix As Long
Sheets("Pricing Detail").Select
Sheets("Pricing Detail").Copy Before:=Sheets(1)
Sheets("Pricing Detail (2)").Name = "Pricing Detail Dummy"
Cells.EntireRow.Hidden = False
Application.Calculation = xlCalculationManual
'*Delete rows in Col F that are blank
Set rng = Intersect(Range("F:F"), ActiveSheet.UsedRange)
For ix = rng.Count To 13 Step -1
If Trim(Replace(rng.Item(ix).Text, Chr(160), Chr(32))) = "" Then
rng.Item(ix).EntireRow.Delete
End If
Next
'*Delete rows in Col I that have "0" in them
Set rng = Intersect(Range("I:I"), ActiveSheet.UsedRange)
For ix = rng.Count To 13 Step -1
If Trim(Replace(rng.Item(ix).Text, Chr(160), Chr(32))) = "0" Then
rng.Item(ix).EntireRow.Delete
End If
Next
'*Delete rows in Col D that are blank (ie warranty lines)
Set rng = Intersect(Range("D:D"), ActiveSheet.UsedRange)
For ix = rng.Count To 13 Step -1
If Trim(Replace(rng.Item(ix).Text, Chr(160), Chr(32))) = "" Then
rng.Item(ix).EntireRow.Delete
End If
Next
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Delete_Rows_With_Parts_No_Longer_Ordered()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
Firstrow = 14
Lastrow = Range("F14").End(xlDown).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "F")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "32 R2906", "F2L088 -6", "USR5686E", "ACK-595UB", _
"14173148", "6073 IFC_V2", "CB -SATD11 - S1", "MK -35 / 525 - HD - BW", _
"2811", "1841", "WIC-1T", "CAB -V35MT", "408", "4221530", "CBL0029", _
"355022", "????", "90-C5XO-1OR": .EntireRow.Delete
End Select
End If
End With
Next Lrow
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
'************************
'Part2: Find the parts and replace with new part numbers
Sub Change_Part_Numbers()
Dim c As Range
Dim TotalParts As Range
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Firstrow = 14
Lastrow = Range("F14").End(xlDown).Row
Set TotalParts = Range("F14:F" & Lastrow)
For Each c In TotalParts
c = Replace(c, "39M5785", "46C7418")
c = Replace(c, "LTA-00040-IHG", "LTA-00040")
c = Replace(c, "12205112", "14344822")
c = Replace(c, "12107484", "14174504")
c = Replace(c, "3400-32", "X3400-V9")
c = Replace(c, "6073-ADU", "6234-A1U")
c = Replace(c, "73P4984", "45J5435")
c = Replace(c, "6073FN_V2", "6234A1U_FN")
c = Replace(c, "6073FO_V2", "6234A1U_FO")
c = Replace(c, "1532N", "30G0100")
c = Replace(c, "39V0214", "30G0802")
c = Replace(c, "WS-C2950-24", "WS-C2960-24TT-L")
c = Replace(c, "SUA1500RM2U", "SUA1500R2X122")
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Copy_Data_From_Pricing_Detail_to_MAPICS_Order()
Dim wSht1 As Worksheet, wSht2 As Worksheet
Dim rng1 As Range
Dim LastCel As Long, lastAdd1cel As Long, lastPartcel As Long
Set wSht1 = Sheets("Pricing Detail Dummy")
Set wSht2 = Sheets("MAPICS Order")
wSht1.Select
LastCel = wSht1.Range("F65536").End(xlUp).Row
Set rng1 = wSht1.Range("F14:F" & LastCel)
Set rng2 = wSht1.Range("I14:I" & LastCel)
Application.ScreenUpdating = False
rng1.Select
rng1.Copy
LastCel = wSht2.Range("X65536").End(xlUp).Row
With wSht2
.Range("X" & LastCel).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End With
rng2.Select
rng2.Copy
LastCel = wSht2.Range("AC65536").End(xlUp).Row
With wSht2
.Range("AC" & LastCel).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End With
wSht2.Select
lastAdd1cel = Range("B65536").End(xlUp).Row
lastPartcel = Range("X65536").End(xlUp).Row
Range("B" & lastAdd1cel).AutoFill Destination:=Range("B" & lastAdd1cel & ":B" & lastPartcel)
With Cells.Font
.Name = "Verdana"
.Size = 8
End With
Range("A2:AE" & lastPartcel).Borders.LineStyle = xlNone
Application.ScreenUpdating = True
End Sub