Copy A Named Range To a Different Sheet

[Minitman]

Greetings,

I have 2 sheets: "Input" and "Budget".

The source list is a named range called "NameSource" (D3839) which
is the list that the new names are being added.

Special problem: the names are not in any particular order and they
are added into the various days of the month. they are not in order,
there are many duplicates and there are a lot of blanks in the middle
of this range called "NameSource"

I need to access this list of customer names, but I need the list
alphabetized and blanks removed.

I tried to do this by coping the range("NameSource") into a helper
sheet called "Customer", into a named range called "NameDest". Then
in a sheet level sub (Worksheet_Change event sub) in the sheet called
"Input", I called up a public sub from a general module.

Here is the sheet sub from sheet "Input":

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
GetSourceNameList
On Error GoTo 0
End Sub

Here is the general module sub:

Public Sub GetSourceNameList()
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlManual
End With
Range("NameSource").Select
Selection.Copy
Sheets("Customers").Select
Range("A3").Select
Selection.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
Range("A1:A839").AdvancedFilter _
Action:=xlFilterInPlace, _
Unique:=True
ActiveCell.SpecialCells(xlLastCell).Select
Range("NameDest").Select
Selection.Sort _
Key1:=Range("A3"), _
Order1:=xlAscending, _
Header:=xlno, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("Input").Select
Range("C3").Select
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlAutomatic
End With

End Sub

This is what the macro recorded gave. It almost works!!!!

There are a couple of "challenges" left yet. :^}

1st problem: the named range has no blank rows showing. There are a
few hundred blank rows, but the blank rows all have a height = 0 (the
default height is 20) and as such I only SEE the rows with data in
them. This looks ok on the surface, but in the "Budget" sheet where
the cells in column A are linked to the "Customer" sheet, each
customer name needs to be in alphabetical order with no blanks. The
way that this macro is working, this list of customer names has the
name in each row and the remainder of the 27 rows in each day are
blank. The 2nd day also has 27 rows reserved for it. First are the
entries for that day and the rest is left blank. And so on until after
the 31st day, then it stops.

Also, this code runs real slow!!!

I did make a macro to make all of the row heights, in the list, equal
to 20. This works, but it take a couple of HOURS to resize these 839
rows!!!

Anyone have any ideas as to where to look to fix this problem?

Any help is greatly appreciated.

-Minitman

 

[Per Jessen]

Hi

You don't see blank rows thus Filter is still active.

Try this, just observe that I use column B in Customer sheet as help
column. If you use column B for other purpose, you can change the
reference "B3" to an unused column.

Public Sub GetSourceNameList()
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlManual
End With

Range("NameSource").Copy
Sheets("Customers").Select
Range("A3").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
Application.CutCopyMode = False

Range("A1:A839").AdvancedFilter _
Action:=xlFilterInPlace, _
Unique:=True
Selection.Copy Range("B3")

ActiveSheet.ShowAllData
Range("A1:A839").Clear

SortRange = Range("B3", Range("B65536").End(xlUp)).Address
Range(SortRange).Sort _
Key1:=Range("B3"), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range(SortRange).Cut Range("A3")

Sheets("Input").Select
Range("C3").Select

With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlAutomatic
End With
End Sub

Best regards,
Per

 

[Minitman]

Hey Per Jessen,

Thanks for the reply and the code.

For some reason after I ran your modified code, my Worksheet_Change
event code stopped working.

Here is the code in the Input sheet code section:

Private Sub Worksheet_Change(ByVal Target As Range)

MsgBox "Target = " & Target.Column
If Target.Column = 4 Then
MsgBox "Chosen Target is " & Target.Column
GetSourceNameList
End If

End Sub

It was almost working! For some reason the last sort never worked?
The list in column B was unsorted and everything in column A was gone
including the header need for the AdvancedFilter. When it stopped
working, I added the MsgBox after the "If" statement - Nothing happens
when I change anything in the 4th column.

I then added the MsgBox as the first item the code would run when
triggered - The code never triggered.

For some reason after I ran the modified code once, I lost the
worksheet change event functionality.

Are there any settings that could have been turned on or off
accidentally?

What did I do wrong?

Any help would be greatly appreciated.

-Minitman


I am at a loss as to what is happening!!!

 

[Per Jessen]

Hi Minitman

I think you'r in break mode, as my code don't have any effect on your
event code.
The unique and sorted list should appear in column A when the macro is
finished.

Change this to avoid deleting headings:

ActiveSheet.ShowAllData
Range("A3:A839").Clear

Best regards,
Per

 

[Minitman]

Hey Per,

Thanks again. I was getting ready to redo everything I had done until
you mentioned break mode. I closed all workbooks and reopened them
and that corrected the event problem.

And the correction from A1 to A3 also worked,

Thanks, I really appreciated you taking the time to help.

-Minitman