Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 30
Default Hide columns and rows then separate the spreadsheet into different files

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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10,124
Default Hide columns and rows then separate the spreadsheet into different files

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.hid den=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


--
Don Guillett
SalesAid Software

"tahrah" wrote in message
ps.com...
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



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Want to Hide columns in spreadsheet but NOT hide data in chart. KrispyData Charts and Charting in Excel 1 March 20th 09 04:45 PM
How do i copy rows to columns on separate sheet, and have them upd Gre Excel Worksheet Functions 2 November 23rd 06 05:36 PM
Comparing two columns in two separate files K Landsworth New Users to Excel 1 June 15th 06 11:43 AM
Import 2 text files into 2 separate columns? tcurrier Excel Discussion (Misc queries) 3 February 11th 06 07:13 PM
How do I link separate Excel files to one spreadsheet? eklushin Excel Discussion (Misc queries) 0 January 6th 06 08:38 PM


All times are GMT +1. The time now is 06:42 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"