Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Excel VBA script not fully working... help!
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 29
Default Excel VBA script not fully working... help!
Hi all,

The script below, gets fields with their data referenced in the array
in the code below from the single sheet and then moves it to a new
sheet where the code continues to execute on. It does some formatting
and then Autofilters 2 columns and it's supposed to Sort column A by
Descending, the part that is not working is below.

The Sort code works by it's self when called from it's own Sub, but
not when part of this routine and not when it's called from this Sub,
not sure why, any ideas ?

Any help would be gladly appreciated, just trying to automate some
brain dead work that's too repeticious.

Thank you.


this With section is not working.... I stepped through the code and
it work up to the Columns("A:I").Select and
the next .Sort line of code is simply ignored, I am not sure why.
Maybe Excel is getting cofused with the Autofilter and Sort in the
same code or something other is happening.

With Selection
ActiveSheet.Columns("A:I").Select
.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
End With

____________________________ full script below

Option Explicit

Sub Step1_MoveColumns()
Dim wsO As Worksheet
Dim wsF As Worksheet
Dim i As Integer
Dim sheetName As String
Dim lr As Long
Dim myColumns As Variant

Worksheets(1).Name = "data"

sheetName = InputBox("Please enter the name of the new Sheet which
will contain your Phone List", "Sheet Name")
Sheets.Add.Name = sheetName

Application.ScreenUpdating = False
Set wsF = Worksheets(sheetName)
Set wsO = Worksheets("data")
myColumns = Array("FLS_SPEND_12_MO", "NAME_FIRST",
"NAME_MIDDLE_1", "NAME_LAST", _
"NAME_SFX", "FLS_STORE_OF_PROMOTION_NUM", "NORD_TLMKT_IND",
"PHONE_HOME", "PB_RELAT_EXSTS_IND")
With Range("A1:BZ1")
For i = 0 To UBound(myColumns)
On Error Resume Next
.Find(myColumns(i)).EntireColumn.Copy
Destination:=wsF.Cells(1, i + 1)
Err.Clear
Next i
End With

ActiveSheet.Range("A1").Value = "Spend Rank"
ActiveSheet.Range("B1").Value = "First Name"
ActiveSheet.Range("C1").Value = "Middle Name"
ActiveSheet.Range("D1").Value = "Last Name"
ActiveSheet.Range("E1").Value = "Suffix"
ActiveSheet.Range("F1").Value = "Store Number"
ActiveSheet.Range("G1").Value = "OK to Call"
ActiveSheet.Range("H1").Value = "Home Phone"
ActiveSheet.Range("I1").Value = "In Personal Book"

With ActiveSheet.Range("A1:I1").Select
Selection.Font.Bold = True
End With

With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

ActiveSheet.Columns("H:H").Select
Selection.NumberFormat = "[<=9999999]###-####;(###) ###-####"
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

lr = Range("A" & Rows.Count).End(xlUp).Row

With ActiveSheet.Range("G1:G" & lr)
On Error Resume Next
.Offset(1, 1).SpecialCells(xlCellTypeBlanks).Value = "Not
Available"
.AutoFilter Field:=1, Criteria1:="N"
.Offset(1, 1).Resize(lr -
1).SpecialCells(xlCellTypeVisible).Value = "Not Available"
Err.Clear
.AutoFilter
End With

With Selection
ActiveSheet.Columns("A:I").Select
.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
End With

Application.ScreenUpdating = True

Set wsO = Nothing
Set wsF = Nothing

End Sub

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
N10 N10 is offline
external usenet poster
  
Posts: 141
Default Excel VBA script not fully working... help!

"RompStar" wrote in message
oups.com...
Hi all,

The script below, gets fields with their data referenced in the array
in the code below from the single sheet and then moves it to a new
sheet where the code continues to execute on. It does some formatting
and then Autofilters 2 columns and it's supposed to Sort column A by
Descending, the part that is not working is below.

The Sort code works by it's self when called from it's own Sub, but
not when part of this routine and not when it's called from this Sub,
not sure why, any ideas ?

Any help would be gladly appreciated, just trying to automate some
brain dead work that's too repeticious.

Thank you.


this With section is not working.... I stepped through the code and
it work up to the Columns("A:I").Select and
the next .Sort line of code is simply ignored, I am not sure why.
Maybe Excel is getting cofused with the Autofilter and Sort in the
same code or something other is happening.

With Selection
ActiveSheet.Columns("A:I").Select
.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
End With

____________________________ full script below

Option Explicit

Sub Step1_MoveColumns()
Dim wsO As Worksheet
Dim wsF As Worksheet
Dim i As Integer
Dim sheetName As String
Dim lr As Long
Dim myColumns As Variant

Worksheets(1).Name = "data"

sheetName = InputBox("Please enter the name of the new Sheet which
will contain your Phone List", "Sheet Name")
Sheets.Add.Name = sheetName

Application.ScreenUpdating = False
Set wsF = Worksheets(sheetName)
Set wsO = Worksheets("data")
myColumns = Array("FLS_SPEND_12_MO", "NAME_FIRST",
"NAME_MIDDLE_1", "NAME_LAST", _
"NAME_SFX", "FLS_STORE_OF_PROMOTION_NUM", "NORD_TLMKT_IND",
"PHONE_HOME", "PB_RELAT_EXSTS_IND")
With Range("A1:BZ1")
For i = 0 To UBound(myColumns)
On Error Resume Next
.Find(myColumns(i)).EntireColumn.Copy
Destination:=wsF.Cells(1, i + 1)
Err.Clear
Next i
End With

ActiveSheet.Range("A1").Value = "Spend Rank"
ActiveSheet.Range("B1").Value = "First Name"
ActiveSheet.Range("C1").Value = "Middle Name"
ActiveSheet.Range("D1").Value = "Last Name"
ActiveSheet.Range("E1").Value = "Suffix"
ActiveSheet.Range("F1").Value = "Store Number"
ActiveSheet.Range("G1").Value = "OK to Call"
ActiveSheet.Range("H1").Value = "Home Phone"
ActiveSheet.Range("I1").Value = "In Personal Book"

With ActiveSheet.Range("A1:I1").Select
Selection.Font.Bold = True
End With

With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

ActiveSheet.Columns("H:H").Select
Selection.NumberFormat = "[<=9999999]###-####;(###) ###-####"
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

lr = Range("A" & Rows.Count).End(xlUp).Row

With ActiveSheet.Range("G1:G" & lr)
On Error Resume Next
.Offset(1, 1).SpecialCells(xlCellTypeBlanks).Value = "Not
Available"
.AutoFilter Field:=1, Criteria1:="N"
.Offset(1, 1).Resize(lr -
1).SpecialCells(xlCellTypeVisible).Value = "Not Available"
Err.Clear
.AutoFilter
End With

With Selection
ActiveSheet.Columns("A:I").Select
.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
End With

Application.ScreenUpdating = True

Set wsO = Nothing
Set wsF = Nothing

End Sub



HI

I tried a slight variation of your sort code which worked in mock up of a
data set. Hope it helps



Range("A2:I2").Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Select


Best N10


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Excel VBA script not fully working... help!
Sometimes selecting a range, working on it and then selecting the next range
makes the code more difficult to understand later. (Yep, that's what the macro
recorder does!)

You may want to try this to see if it does what you want. It compiled for me,
but I didn't take the time to set up a bunch of data to do any real testing.

Option Explicit
Sub Step1_MoveColumns()
Dim wsO As Worksheet
Dim wsF As Worksheet
Dim i As Long
Dim sheetName As String
Dim lr As Long
Dim myColumns As Variant

Set wsO = Worksheets(1)

sheetName = InputBox("Please enter the name of the new Sheet " _
& "which will contain your Phone List", "Sheet Name")
If sheetName = "" Then
Exit Sub
End If
Set wsF = Sheets.Add
wsF.Name = sheetName

Application.ScreenUpdating = False
myColumns = Array("FLS_SPEND_12_MO", "NAME_FIRST", _
"NAME_MIDDLE_1", "NAME_LAST", _
"NAME_SFX", "FLS_STORE_OF_PROMOTION_NUM", _
"NORD_TLMKT_IND", "PHONE_HOME", _
"PB_RELAT_EXSTS_IND")


With wsO.Range("A1:BZ1")
On Error Resume Next
For i = LBound(myColumns) To UBound(myColumns)
.Find(what:=myColumns(i), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByColumns, _
searchdirection:=xlNext, _
MatchCase:=False).EntireColumn.Copy _
Destination:=wsF.Cells(1, i + 1)
Next i
On Error GoTo 0
End With

With wsF
.Range("A1").Resize(1, 9).Value _
= Array("Spend Rank", _
"First Name", _
"Middle Name", _
"Last Name", _
"Suffix", _
"Store Number", _
"OK to Call", _
"Home Phone", _
"In Personal Book")

With .Range("A1:I1")
.Font.Bold = True
With .Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
End With

.Columns("H:H").NumberFormat = "[<=9999999]###-####;(###) ###-####"
.Cells.EntireColumn.AutoFit

With .Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

lr = .Range("A" & .Rows.Count).End(xlUp).Row

With .Range("G1:G" & lr)
On Error Resume Next
.Offset(1, 1).SpecialCells(xlCellTypeBlanks).Value = "Not Available"
.AutoFilter Field:=1, Criteria1:="N"
.Offset(1, 1).Resize(lr - 1).SpecialCells(xlCellTypeVisible).Value _
= "Not Available"
On Error GoTo 0
.AutoFilter
End With

With .Columns("A:I")
.Sort Key1:=.Columns(1), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End With

Application.ScreenUpdating = True

Set wsO = Nothing
Set wsF = Nothing

End Sub

RompStar wrote:

Hi all,

The script below, gets fields with their data referenced in the array
in the code below from the single sheet and then moves it to a new
sheet where the code continues to execute on. It does some formatting
and then Autofilters 2 columns and it's supposed to Sort column A by
Descending, the part that is not working is below.

The Sort code works by it's self when called from it's own Sub, but
not when part of this routine and not when it's called from this Sub,
not sure why, any ideas ?

Any help would be gladly appreciated, just trying to automate some
brain dead work that's too repeticious.

Thank you.

this With section is not working.... I stepped through the code and
it work up to the Columns("A:I").Select and
the next .Sort line of code is simply ignored, I am not sure why.
Maybe Excel is getting cofused with the Autofilter and Sort in the
same code or something other is happening.

With Selection
ActiveSheet.Columns("A:I").Select
.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
End With

____________________________ full script below

Option Explicit

Sub Step1_MoveColumns()
Dim wsO As Worksheet
Dim wsF As Worksheet
Dim i As Integer
Dim sheetName As String
Dim lr As Long
Dim myColumns As Variant

Worksheets(1).Name = "data"

sheetName = InputBox("Please enter the name of the new Sheet which
will contain your Phone List", "Sheet Name")
Sheets.Add.Name = sheetName

Application.ScreenUpdating = False
Set wsF = Worksheets(sheetName)
Set wsO = Worksheets("data")
myColumns = Array("FLS_SPEND_12_MO", "NAME_FIRST",
"NAME_MIDDLE_1", "NAME_LAST", _
"NAME_SFX", "FLS_STORE_OF_PROMOTION_NUM", "NORD_TLMKT_IND",
"PHONE_HOME", "PB_RELAT_EXSTS_IND")
With Range("A1:BZ1")
For i = 0 To UBound(myColumns)
On Error Resume Next
.Find(myColumns(i)).EntireColumn.Copy
Destination:=wsF.Cells(1, i + 1)
Err.Clear
Next i
End With

ActiveSheet.Range("A1").Value = "Spend Rank"
ActiveSheet.Range("B1").Value = "First Name"
ActiveSheet.Range("C1").Value = "Middle Name"
ActiveSheet.Range("D1").Value = "Last Name"
ActiveSheet.Range("E1").Value = "Suffix"
ActiveSheet.Range("F1").Value = "Store Number"
ActiveSheet.Range("G1").Value = "OK to Call"
ActiveSheet.Range("H1").Value = "Home Phone"
ActiveSheet.Range("I1").Value = "In Personal Book"

With ActiveSheet.Range("A1:I1").Select
Selection.Font.Bold = True
End With

With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

ActiveSheet.Columns("H:H").Select
Selection.NumberFormat = "[<=9999999]###-####;(###) ###-####"
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

lr = Range("A" & Rows.Count).End(xlUp).Row

With ActiveSheet.Range("G1:G" & lr)
On Error Resume Next
.Offset(1, 1).SpecialCells(xlCellTypeBlanks).Value = "Not
Available"
.AutoFilter Field:=1, Criteria1:="N"
.Offset(1, 1).Resize(lr -
1).SpecialCells(xlCellTypeVisible).Value = "Not Available"
Err.Clear
.AutoFilter
End With

With Selection
ActiveSheet.Columns("A:I").Select
.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
End With

Application.ScreenUpdating = True

Set wsO = Nothing
Set wsF = Nothing

End Sub

--

Dave Peterson
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 140
Default Excel VBA script not fully working... help!
Hi

Use this as a replacement. The selection at the start of the second
line was missing. Also not all the code is needed so this simplified
version will work ok.
Take Care
Marcus

Columns("A:I").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending,
Header:=xlYes, OrderCustom:=1


Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 29
Default Excel VBA script not fully working... help!
HI all!

Thanks to everyone who has taken the time to help me and special
thanks for Dave Peterson, now
I can learn more and finish off some formatting, very interesting on
some of the things that you have
added.

Thank you again.

ROmpStar


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

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
Edit Menu shortcut not fully working EricGoldman Excel Discussion (Misc queries) 2 July 23rd 09 06:50 PM
window does not fully maximize in Excel calliance Excel Discussion (Misc queries) 3 February 2nd 09 09:12 PM
Script Not working Esssa Excel Worksheet Functions 11 September 6th 08 09:41 PM
Column Hidding Script not working chinny Excel Programming 2 May 13th 07 01:11 AM
Excel VB Script Not Working in Explorer Carrie[_3_] Excel Programming 2 May 19th 04 12:46 AM


All times are GMT +1. The time now is 07:12 AM.

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"

 

Contact Us ExcelBanter forum home Privacy Statement