I'd like to create a Macro that will sort some raw data, apprx 20k lines,
remove some lines based upon a condition in a certain column. Then copy this
data into a new spreadsheet and sort the data again and delete the unwanted
data and repeat few more times in new sheets. End product will be
apprximately 7 or 8 sheets - 1 for Active Customers, Inactive Customers,
Pending Installs, Etc...
I'm getting hung up I believe with naming ranges. I can't seem to be able
to reuse my Ranges in differnt sheets. I've tried putting these ranges in a
new macro and point to a different sheet, but I'm probably missing something.
Below is my code:
Sub Install_Base()
Dim currentCell As Variant
With ActiveSheet
'Step 1 thru 6 of Install Base Job Doc
'-------------------------------------------------------------------------------
'Delete Columns AL-AZ
Columns("AL:AZ").Select
Selection.EntireColumn.Delete
'Delete Columns U-AH
Columns("U:AH").Select
Selection.EntireColumn.Delete
'Delete Columns D-J
Columns("D:J").Select
Selection.EntireColumn.Delete
'Move Column A to B
Columns("F:G").Cut
Columns("C:C").Insert Shift:=xlToRight
'Insert 3 columns between BU and Parent
Columns("H:J").Select
Selection.Insert Shift:=xlToRight
'Name Columns H thru J, "Count", "Region", and "Warranty" and Today's Date
Range("H2").Value = "Count"
Range("I2").Value = "Region"
Range("J2").Value = "Warranty"
Range("F1").Value = "Report Date:"
Range("G1") = Date
'Name Colums T - This column will be used to identify Systems Parts Only and
macro will
'delete non sytem part #'s
Range("T2").Value = "If Systems Part #s - Keep. Otherwise, delete"
'Name Colums U - This column will be used to Active or Pending Install
Range("U2").Value = "Active /Pending Install"
'Add a "1" to all the Rows in the Count columns
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
..Range("H3:H" & lastrow).Formula = "1"
'Add a Vlookup formula to determine Regions in Column I
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
..Range("I3:I" & lastrow).Formula = "=VLOOKUP(F3,Region!$A$2:$B$47,2,0)"
'Add a Formula to determine Warranty Status in Column J
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
..Range("J3:J" & lastrow).Formula = "=IF(P3>=$G$1,""Warranty"",""Expired"")"
'Add a Formula to determine whether a Systems Part # exist in Column T - 1
for exist, 0 for Non Systems items
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
..Range("T3:T" & lastrow).Formula =
"=IF(ISERROR(VLOOKUP(C3,Region!$I$2:$N$85,6,0))=TR UE,""Remove"",IF(VLOOKUP(C3,Region!$I$2:$N$85,6,0) =""Ignore"",""Remove"",""Keep""))"
'Add a Formula to Active or Pending Install
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
..Range("U3:U" & lastrow).Formula = "=IF(O3>0,""Active"",""Pending"")"
'Adjust Column Width to Autofit
Columns("A:S").Select
Selection.EntireColumn.AutoFit
'Highlight Columns C-D,H-J,L,Q-R with Blue Font
Range("C:D").Font.ColorIndex = 5
Range("H:J").Font.ColorIndex = 5
Range("L:L").Font.ColorIndex = 5
Range("Q:R").Font.ColorIndex = 5
'Set Workbook aligmnent to Left Indent
Worksheets("Edited").Range("A:S").HorizontalAlignm ent = xlLeft
'Sort the Data by Column T to increase the efficiency of the next Macro
Range("A2:T25000").Select
Selection.Sort Key1:=Range("T2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Delete Rows if Non Sytems items exist - value = 0, Column T of Edited sheet
Dim Rng As Range
Dim rngToDelete As Range
Dim rngToSearch As Range
Set rngToSearch = .Range(.Range("T2"), .Cells(Rows.Count, "T").End(xlUp))
.DisplayPageBreaks = False
For Each Rng In rngToSearch
If Rng.Value = "Remove" Then
If rngToDelete Is Nothing Then
Set rngToDelete = Rng
Else
Set rngToDelete = Union(Rng, rngToDelete)
End If
End If
Next Rng
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
'Sort the Data by Column T to increase the efficiency of the next Macro
Range("A2:T25000").Select
Selection.Sort Key1:=Range("O2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Place cell in B1 once Macro finishes
Range("B1").Select
'Add a Formula to Active or Pending Install
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
If Cell.Value = "0" Then
..Range("T3:T" & lastrow).Formula = "=IF(O3>0,""Active"",""Pending"")"
End If
'-----------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
ActiveSheet.Copy After:=Worksheets("Edited")
Worksheets(4).Name = "Customer Active"
ActiveSheet.Copy After:=Worksheets("Customer Active")
Worksheets(5).Name = "Internal Active"
ActiveSheet.Copy After:=Worksheets("Internal Active")
Worksheets(6).Name = "Pending Install"
ActiveSheet.Copy After:=Worksheets("Pending Install")
Worksheets(7).Name = "All Inactive"
ActiveSheet.Copy After:=Worksheets("All Inactive")
Worksheets(8).Name = "FS"
ActiveSheet.Copy After:=Worksheets("FS")
Worksheets(9).Name = "AL"
ActiveSheet.Copy After:=Worksheets("AL")
Worksheets(10).Name = "Scanners"
End With
End Sub
Sub Edit_Customer() 'Edit Customer Active Sheet
Dim currentCell As Variant
Sheets("Customer Active").Activate
With ActiveSheet
'Delete Rows if Non Sytems items exist - value = 0, Column T of Edited sheet
Dim Rng As Range
Dim rngToDelete As Range
Dim rngToSearch As Range
Set rngToSearch = .Range(.Range("U2"), .Cells(Rows.Count, "U").End(xlUp))
.DisplayPageBreaks = False
For Each Rng In rngToSearch
If Rng.Value = "Pending" Then
If rngToDelete Is Nothing Then
Set rngToDelete = Rng
Else
Set rngToDelete = Union(Rng, rngToDelete)
End If
End If
Next Rng
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
End With
'Sort the Customer Active sheet by Column U, Pending Install Yes or No
' With ActiveSheet
' Range("A2:T25000").Select
' Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
' DataOption1:=xlSortNormal
'Place cell in B1 once Macro finishes
'Range("B1").Select
'End With
End Sub
Sub Internal_Active() 'Macro to edit the Internal Active sheet
Sheets("Internal Active").Activate
With ActiveSheet
Dim EndData As Long
Application.ScreenUpdating = False
EndData = Cells(Rows.Count, 1).End(xlUp).Row
With Range(Cells(2, 1), Cells(EndData, 2))
.Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.ScreenUpdating = True
End With
End Sub
Sub Pending_Install() 'Macro to edit the Pending Install sheet
Sheets("Internal Active").Activate
With ActiveSheet
Dim EndData As Long
Application.ScreenUpdating = False
EndData = Cells(Rows.Count, 1).End(xlUp).Row
With Range(Cells(2, 1), Cells(EndData, 2))
.Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.ScreenUpdating = True
End With
End Sub
Sub All_Inactive() 'Macro to edit the All Inactive sheet
End Sub
Sub All_FS() 'Macro to edit the FS sheet
End Sub
Sub Scanners() 'Macro to edit the Scanners sheet
End Sub
Private Sub CommandButton2_Click() 'This Macro will run all of the above
Macros
Call Install_Base
Call Edit_Customer
'Call Internal_Active
'Call Pending_Install
End Sub
