Excel VBA script not fully working... help!

R

RompStar

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
 
N

N10

RompStar said:
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
Click to expand...


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
 
D

Dave Peterson

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
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
Click to expand...
 
M

marcus

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
 
R

RompStar

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
 

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

Similar Threads

VBA Coding Help for Beginner 0
Help me4 2
Word macro that can call cells out of Excel for a find and replace 0
VBA Pivot Table Error 1
Excel VB to create and send an outlook appointment with html code 1
Button Problem with the Sort command 7
VBA - exporting serial letters to single documents 0
VBA Filter 2

Top