T
tahrah
I have tried to combine two macros to get my results but it's not
working. I want to hide particular columns and rows, then hide rows
with particular information in a certain field, then separate ONLY the
remaining information into separate spreadsheets based on the rep's
name in another column. Here is the macro below. It's hiding the
columns and rows correctly and only showing the open quotes, and it is
creating the separate spreadsheets, but it's still copying over ALL
rows for each rep instead of just their open quotes.
Sub Create_Open_Quote_Sheets_By_Reps()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WBNew As Workbook
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim FileFolder As String
Dim lngRow As Long
Columns("A:C").EntireColumn.Hidden = True
Columns("E:G").EntireColumn.Hidden = True
Columns("I:I").EntireColumn.Hidden = True
Columns("T:T").EntireColumn.Hidden = True
Columns("V:AM").EntireColumn.Hidden = True
Rows("5:2001").Sort Key1:=Range("Q2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
lngRow = Range("Q2001").End(xlUp).Row + 1
Rows(lngRow & ":2001").EntireRow.Hidden = True
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "order received" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "order received" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "Order received" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "ORDER RECEIVED" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "Order Received" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
FileFolder = "C:\reps\" '<<< Change
Set ws1 = ThisWorkbook.Sheets("Quotes-Samples-Orders") '<<< Change
'Tip : You can also use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ws1
'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used to
make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use
the columns)
rng.Columns(12).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value
For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WBNew = Workbooks.Add
On Error Resume Next
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WBNew.Sheets(1).Range("A1"), _
Unique:=False
WBNew.Sheets(1).Columns.AutoFit
WBNew.SaveAs FileFolder & Format(Now, "mmm-dd-yyyy") & "
Open-Quotes " & cell.Value
WBNew.Close False
Next
.Columns("IU:IV").Clear
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
Cells.Select
Selection.EntireRow.Hidden = False
Selection.EntireColumn.Hidden = False
Rows("5:2002").Select
Selection.Sort Key1:=Range("B5"), Order1:=xlAscending,
Key2:=Range("A5") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("B4").Select
End Sub
working. I want to hide particular columns and rows, then hide rows
with particular information in a certain field, then separate ONLY the
remaining information into separate spreadsheets based on the rep's
name in another column. Here is the macro below. It's hiding the
columns and rows correctly and only showing the open quotes, and it is
creating the separate spreadsheets, but it's still copying over ALL
rows for each rep instead of just their open quotes.
Sub Create_Open_Quote_Sheets_By_Reps()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WBNew As Workbook
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim FileFolder As String
Dim lngRow As Long
Columns("A:C").EntireColumn.Hidden = True
Columns("E:G").EntireColumn.Hidden = True
Columns("I:I").EntireColumn.Hidden = True
Columns("T:T").EntireColumn.Hidden = True
Columns("V:AM").EntireColumn.Hidden = True
Rows("5:2001").Sort Key1:=Range("Q2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
lngRow = Range("Q2001").End(xlUp).Row + 1
Rows(lngRow & ":2001").EntireRow.Hidden = True
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "order received" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "order received" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "Order received" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "ORDER RECEIVED" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
For Each rngCell In Range("U1", Cells(lngRow - 1, "U"))
If rngCell.Value = "Order Received" Then
rngCell.EntireRow.Hidden = True
End If
Next 'rngCell
FileFolder = "C:\reps\" '<<< Change
Set ws1 = ThisWorkbook.Sheets("Quotes-Samples-Orders") '<<< Change
'Tip : You can also use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ws1
'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used to
make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use
the columns)
rng.Columns(12).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value
For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WBNew = Workbooks.Add
On Error Resume Next
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WBNew.Sheets(1).Range("A1"), _
Unique:=False
WBNew.Sheets(1).Columns.AutoFit
WBNew.SaveAs FileFolder & Format(Now, "mmm-dd-yyyy") & "
Open-Quotes " & cell.Value
WBNew.Close False
Next
.Columns("IU:IV").Clear
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
Cells.Select
Selection.EntireRow.Hidden = False
Selection.EntireColumn.Hidden = False
Rows("5:2002").Select
Selection.Sort Key1:=Range("B5"), Order1:=xlAscending,
Key2:=Range("A5") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("B4").Select
End Sub