View Single Post
  #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