Hide columns and rows then separate the spreadsheet into different files

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
 
D

Don Guillett

I'm a bit hazy on your code but for the copy visible you might take a look
in the vba help for SPECIALCELLS, especially xlvisible.

There are some other things that might improve your code
If rngCell.Value = "ORDER RECEIVED" Then
rngCell.EntireRow.Hidden = True

This will cover all contingencies
If ucase(rngCell) = "ORDER RECEIVED" Then rngCell.EntireRow.Hidden = True

also
range("a1:c1,e1:g1,i1,t1,v1:am1").entirecolumn.hidden=true

instead of
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
Cells.Select
Selection.EntireRow.Hidden = False
Selection.EntireColumn.Hidden = False
can be without cells.select
rows.hidden=false
columns.hidden=false
etc,etc
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top