Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Site www.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

Rashid Khan

If you post a bit of your sample data, and examples of what's being
duplicated, someone may be able to help.


wrote:
Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Site www.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

Rashid Khan



--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html

On Feb 15, 6:00 am, Debra Dalgleish wrote:
If you post a bit of your sample data, and examples of what's being
duplicated, someone may be able to help.





wrote:
Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Sitewww.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html- Hide quoted text -

- Show quoted text -

Hello Debra,
Thanks for your prompt response. This is the sample format

A Code

B Party Name

C Inv Date

D Inv Amt

E Pmt Date

F Pmt Amt

G Balance (Formula is D - F)

There are 2 Sheets viz Main& Customers. After I run the code Data from
Columns C and D from Main Sheet is repeated on the extracted Sheet in
Columns E and F respectively.
As you may be aware that the entries are not contiguous and the new
worksheet is created according to Column A names of Main Sheet. I need
to have the individual worksheet created according to the names in
Column A and the data from C and D should not be repeated in E and F

Does this gives you some clue?
Rashid Khan

It doesn't give me a clue.

But I'm wondering if you have formulas in those cells--and maybe the formula is
not working correctly?

If you create a test workbook and convert all the formulas to values, what
happens when you run the code?



wrote:

On Feb 15, 6:00 am, Debra Dalgleish wrote:
If you post a bit of your sample data, and examples of what's being
duplicated, someone may be able to help.





wrote:
Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Sitewww.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html- Hide quoted text -

- Show quoted text -

Hello Debra,
Thanks for your prompt response. This is the sample format

A Code

B Party Name

C Inv Date

D Inv Amt

E Pmt Date

F Pmt Amt

G Balance (Formula is D - F)

There are 2 Sheets viz Main& Customers. After I run the code Data from
Columns C and D from Main Sheet is repeated on the extracted Sheet in
Columns E and F respectively.
As you may be aware that the entries are not contiguous and the new
worksheet is created according to Column A names of Main Sheet. I need
to have the individual worksheet created according to the names in
Column A and the data from C and D should not be repeated in E and F

Does this gives you some clue?
Rashid Khan

--

Dave Peterson

It looks fine to me too. Maybe something is happening in the
SetColumnWidth procedure.


wrote:
On Feb 15, 6:00 am, Debra Dalgleish wrote:

If you post a bit of your sample data, and examples of what's being
duplicated, someone may be able to help.





wrote:

Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Sitewww.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html- Hide quoted text -

- Show quoted text -


Hello Debra,
Thanks for your prompt response. This is the sample format

A Code

B Party Name

C Inv Date

D Inv Amt

E Pmt Date

F Pmt Amt

G Balance (Formula is D - F)

There are 2 Sheets viz Main& Customers. After I run the code Data from
Columns C and D from Main Sheet is repeated on the extracted Sheet in
Columns E and F respectively.
As you may be aware that the entries are not contiguous and the new
worksheet is created according to Column A names of Main Sheet. I need
to have the individual worksheet created according to the names in
Column A and the data from C and D should not be repeated in E and F

Does this gives you some clue?
Rashid Khan



--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html

On Feb 15, 8:58 pm, Debra Dalgleish wrote:
It looks fine to me too. Maybe something is happening in the
SetColumnWidth procedure.





wrote:
On Feb 15, 6:00 am, Debra Dalgleish wrote:

If you post a bit of your sample data, and examples of what's being
duplicated, someone may be able to help.

wrote:

Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Sitewww.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html-Hide quoted text -

- Show quoted text -

Hello Debra,
Thanks for your prompt response. This is the sample format

A Code

B Party Name

C Inv Date

D Inv Amt

E Pmt Date

F Pmt Amt

G Balance (Formula is D - F)

There are 2 Sheets viz Main& Customers. After I run the code Data from
Columns C and D from Main Sheet is repeated on the extracted Sheet in
Columns E and F respectively.
As you may be aware that the entries are not contiguous and the new
worksheet is created according to Column A names of Main Sheet. I need
to have the individual worksheet created according to the names in
Column A and the data from C and D should not be repeated in E and F

Does this gives you some clue?
RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html- Hide quoted text -

- Show quoted text -

Thanks Dave and Debra
Dave...There are no formulas in any of the columns except in Column G
Debra...I am giving the macro Setwidth for your reference

Sub SetColumnWidth()
Dim WS As Worksheet
Application.EnableEvents = False


For Each WS In Worksheets
WS.Columns.AutoFit
Next
Application.EnableEvents = True
End Sub

Thanks both of you for your prompt attention
Rashid Khan

Do you have the same result if you delete all the destination sheets,
and run the macro?

wrote:
On Feb 15, 8:58 pm, Debra Dalgleish wrote:

It looks fine to me too. Maybe something is happening in the
SetColumnWidth procedure.





wrote:

On Feb 15, 6:00 am, Debra Dalgleish wrote:

If you post a bit of your sample data, and examples of what's being
duplicated, someone may be able to help.

wrote:

Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Sitewww.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html-Hide quoted text -

- Show quoted text -

Hello Debra,
Thanks for your prompt response. This is the sample format

A Code

B Party Name

C Inv Date

D Inv Amt

E Pmt Date

F Pmt Amt

G Balance (Formula is D - F)

There are 2 Sheets viz Main& Customers. After I run the code Data from
Columns C and D from Main Sheet is repeated on the extracted Sheet in
Columns E and F respectively.
As you may be aware that the entries are not contiguous and the new
worksheet is created according to Column A names of Main Sheet. I need
to have the individual worksheet created according to the names in
Column A and the data from C and D should not be repeated in E and F

Does this gives you some clue?
RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html- Hide quoted text -

- Show quoted text -


Thanks Dave and Debra
Dave...There are no formulas in any of the columns except in Column G
Debra...I am giving the macro Setwidth for your reference

Sub SetColumnWidth()
Dim WS As Worksheet
Application.EnableEvents = False


For Each WS In Worksheets
WS.Columns.AutoFit
Next
Application.EnableEvents = True
End Sub

Thanks both of you for your prompt attention
Rashid Khan




--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html

On Feb 15, 11:12 pm, Debra Dalgleish
wrote:
Do you have the same result if you delete all the destination sheets,
and run the macro?





wrote:
On Feb 15, 8:58 pm, Debra Dalgleish wrote:

It looks fine to me too. Maybe something is happening in the
SetColumnWidth procedure.

wrote:

On Feb 15, 6:00 am, Debra Dalgleish wrote:

If you post a bit of your sample data, and examples of what's being
duplicated, someone may be able to help.

wrote:

Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Sitewww.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html-Hidequoted text -

- Show quoted text -

Hello Debra,
Thanks for your prompt response. This is the sample format

A Code

B Party Name

C Inv Date

D Inv Amt

E Pmt Date

F Pmt Amt

G Balance (Formula is D - F)

There are 2 Sheets viz Main& Customers. After I run the code Data from
Columns C and D from Main Sheet is repeated on the extracted Sheet in
Columns E and F respectively.
As you may be aware that the entries are not contiguous and the new
worksheet is created according to Column A names of Main Sheet. I need
to have the individual worksheet created according to the names in
Column A and the data from C and D should not be repeated in E and F

Does this gives you some clue?
RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html-Hide quoted text -

- Show quoted text -

Thanks Dave and Debra
Dave...There are no formulas in any of the columns except in Column G
Debra...I am giving the macro Setwidth for your reference

Sub SetColumnWidth()
Dim WS As Worksheet
Application.EnableEvents = False

For Each WS In Worksheets
WS.Columns.AutoFit
Next
Application.EnableEvents = True
End Sub

Thanks both of you for your prompt attention
RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html- Hide quoted text -

- Show quoted text -

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and help
Rashid Khan

On Feb 16, 11:08 am, wrote:
On Feb 15, 11:12 pm, Debra Dalgleish
wrote:





Do you have the same result if you delete all the destination sheets,
and run the macro?

wrote:
On Feb 15, 8:58 pm, Debra Dalgleish wrote:

It looks fine to me too. Maybe something is happening in the
SetColumnWidth procedure.

wrote:

On Feb 15, 6:00 am, Debra Dalgleish wrote:

If you post a bit of your sample data, and examples of what's being
duplicated, someone may be able to help.

wrote:

Hello All,
I am using Windows XP/Office 2003 and have the following problem

I have downloaded a file from Debra Dalgleish's Web Sitewww.contexture.com(File
Name:AdvFilterCity.Zip) and tried to change it to suit my needs.

But I have few problems with it...as shown in the JPG files viz. Before
and After.
(I have made JPG files)

The File name "Before" shows the actual entry and the File name
"After" shows when the macro FilterCities is run.

As can be seen in the file "After" in Columns F & G ...same data is
repeated from columns C & D. This is what is going wrong.

When the macro FilterCities is run I need to have the entire row
(Columns A to H) copied one below other as shown in File "Before"

Following is the macro

Option Explicit

Sub FilterCities()

Dim myCell As Range
Dim wks As Worksheet
Dim DataBaseWks As Worksheet
Dim ListRange As Range
Dim dummyRng As Range
Dim myDatabase As Range
Dim TempWks As Worksheet
Dim rsp As Integer
Dim i As Long

'include bottom most header row
Const TopLeftCellOfDataBase As String = "A4"

'what column has your key values
Const KeyColumn As String = "A"

'where's your data
Set DataBaseWks = Worksheets("Main")
i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1

rsp = MsgBox("Include headings?", vbYesNo, "Headings")

Set TempWks = Worksheets.Add

With DataBaseWks
Set dummyRng = .UsedRange
Set myDatabase = .Range(TopLeftCellOfDataBase, _
.Cells.SpecialCells(xlCellTypeLastCell))
End With

'rebuild the List
With DataBaseWks
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), _
Unique:=True

'Add the heading to the criteria area
TempWks.Range("D1").Value = _
.Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value
End With

With TempWks
Set ListRange = .Range("a2", .Cells(.Rows.Count,
"A").End(xlUp))
End With

With ListRange
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

'check for individual City worksheets
For Each myCell In ListRange.Cells
If WksExists(myCell.Value) = False Then
Set wks = Sheets.Add
On Error Resume Next
wks.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Please rename: " & wks.Name
Err.Clear
End If
On Error GoTo 0
wks.Move after:=Sheets(Sheets.Count)
Else
Set wks = Worksheets(myCell.Value)
wks.Cells.Clear
End If

If rsp = 6 Then
DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1")
End If

'change the criteria in the Criteria range
TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value
& Chr(34)

'transfer data to individual City worksheets
If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
Next myCell

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

MsgBox "Data has been sent"
Call SetColumnWidth
Sheets("MAIN").Select
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

I can mail the JPG files to someone who wish to help me out
Can anybody help me out please?

TIA

RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html-Hidequotedtext -

- Show quoted text -

Hello Debra,
Thanks for your prompt response. This is the sample format

A Code

B Party Name

C Inv Date

D Inv Amt

E Pmt Date

F Pmt Amt

G Balance (Formula is D - F)

There are 2 Sheets viz Main& Customers. After I run the code Data from
Columns C and D from Main Sheet is repeated on the extracted Sheet in
Columns E and F respectively.
As you may be aware that the entries are not contiguous and the new
worksheet is created according to Column A names of Main Sheet. I need
to have the individual worksheet created according to the names in
Column A and the data from C and D should not be repeated in E and F

Does this gives you some clue?
RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html-Hidequoted text -

- Show quoted text -

Thanks Dave and Debra
Dave...There are no formulas in any of the columns except in Column G
Debra...I am giving the macro Setwidth for your reference

Sub SetColumnWidth()
Dim WS As Worksheet
Application.EnableEvents = False

For Each WS In Worksheets
WS.Columns.AutoFit
Next
Application.EnableEvents = True
End Sub

Thanks both of you for your prompt attention
RashidKhan

--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html-Hide quoted text -

- Show quoted text -

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:
<<snipped




Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson

On Feb 16, 7:23 pm, Dave Peterson wrote:
If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped







Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
Rashid Khan

Try stepping through the code. After each "major" step, go back to excel and
look to see if things look ok.

When you process a line that screws up the data, you'll know what's causing the
trouble.

wrote:

On Feb 16, 7:23 pm, Dave Peterson wrote:
If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped







Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
Rashid Khan

--

Dave Peterson

On Feb 17, 5:19 pm, Dave Peterson wrote:
Try stepping through the code. After each "major" step, go back to excel and
look to see if things look ok.

When you process a line that screws up the data, you'll know what's causing the
trouble.





wrote:

On Feb 16, 7:23 pm, Dave Peterson wrote:
If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I run the routine and following lines is giving problem:

If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
When the above code is run the data from Columns C & D is repeated in
Columns F & G respectively on the individual sheets.
Thanks for your time and assistance

Rashid Khan

Do you have any duplicated headers in your data? If you do, change them so each
header is unique.

wrote:

On Feb 17, 5:19 pm, Dave Peterson wrote:
Try stepping through the code. After each "major" step, go back to excel and
look to see if things look ok.

When you process a line that screws up the data, you'll know what's causing the
trouble.





wrote:

On Feb 16, 7:23 pm, Dave Peterson wrote:
If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I run the routine and following lines is giving problem:

If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
When the above code is run the data from Columns C & D is repeated in
Columns F & G respectively on the individual sheets.
Thanks for your time and assistance

Rashid Khan

--

Dave Peterson

On Feb 18, 5:46 pm, Dave Peterson wrote:
Do you have any duplicated headers in your data? If you do, change them so each
header is unique.





wrote:

On Feb 17, 5:19 pm, Dave Peterson wrote:
Try stepping through the code. After each "major" step, go back to excel and
look to see if things look ok.

When you process a line that screws up the data, you'll know what's causing the
trouble.

wrote:

On Feb 16, 7:23 pm, Dave Peterson wrote:
If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I run the routine and following lines is giving problem:

If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
When the above code is run the data from Columns C & D is repeated in
Columns F & G respectively on the individual sheets.
Thanks for your time and assistance

RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hi Dave,
Voila....that was it... I changed the header and it works
perfectly...Thanks a million for your help.

You once again saved my day

Rashid Khan

One favor.

You may have noticed that in the ms excel newsgroups, most people put their
replies at the top.

You may want to start doing this while you're in these newsgroups.

(Yep. Other (most??) newsgroups follow bottom posting and snipping. We're
different here <bg.)



wrote:

On Feb 18, 5:46 pm, Dave Peterson wrote:
Do you have any duplicated headers in your data? If you do, change them so each
header is unique.





wrote:

On Feb 17, 5:19 pm, Dave Peterson wrote:
Try stepping through the code. After each "major" step, go back to excel and
look to see if things look ok.

When you process a line that screws up the data, you'll know what's causing the
trouble.

wrote:

On Feb 16, 7:23 pm, Dave Peterson wrote:
If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I run the routine and following lines is giving problem:

If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
When the above code is run the data from Columns C & D is repeated in
Columns F & G respectively on the individual sheets.
Thanks for your time and assistance

RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hi Dave,
Voila....that was it... I changed the header and it works
perfectly...Thanks a million for your help.

You once again saved my day

Rashid Khan

--

Dave Peterson

Hello Dave,
Sorry for my ignorance. Thanks for guiding me. I would take care in
my future postings.
Rashid Khan

On Feb 19, 6:24 pm, Dave Peterson wrote:
One favor.

You may have noticed that in the ms excel newsgroups, most people put their
replies at the top.

You may want to start doing this while you're in these newsgroups.

(Yep. Other (most??) newsgroups follow bottom posting and snipping. We're
different here <bg.)





wrote:

On Feb 18, 5:46 pm, Dave Peterson wrote:
Do you have any duplicated headers in your data? If you do, change them so each
header is unique.

wrote:

On Feb 17, 5:19 pm, Dave Peterson wrote:
Try stepping through the code. After each "major" step, go back to excel and
look to see if things look ok.

When you process a line that screws up the data, you'll know what's causing the
trouble.

wrote:

On Feb 16, 7:23 pm, Dave Peterson wrote:
If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I run the routine and following lines is giving problem:

If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
When the above code is run the data from Columns C & D is repeated in
Columns F & G respectively on the individual sheets.
Thanks for your time and assistance

RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hi Dave,
Voila....that was it... I changed the header and it works
perfectly...Thanks a million for your help.

You once again saved my day

Rashid Khan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Thanks! Glad you figured it out. I've added a note to the sample file,
mentioning that the headings must be unique.

Dave Peterson wrote:
Do you have any duplicated headers in your data? If you do, change them so each
header is unique.

wrote:

On Feb 17, 5:19 pm, Dave Peterson wrote:

Try stepping through the code. After each "major" step, go back to excel and
look to see if things look ok.

When you process a line that screws up the data, you'll know what's causing the
trouble.





wrote:


On Feb 16, 7:23 pm, Dave Peterson wrote:

If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I run the routine and following lines is giving problem:

If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
When the above code is run the data from Columns C & D is repeated in
Columns F & G respectively on the individual sheets.
Thanks for your time and assistance

Rashid Khan




--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html

Even a blind squirrel finds an acorn now and again!

Debra Dalgleish wrote:

Thanks! Glad you figured it out. I've added a note to the sample file,
mentioning that the headings must be unique.

Dave Peterson wrote:
Do you have any duplicated headers in your data? If you do, change them so each
header is unique.

wrote:

On Feb 17, 5:19 pm, Dave Peterson wrote:

Try stepping through the code. After each "major" step, go back to excel and
look to see if things look ok.

When you process a line that screws up the data, you'll know what's causing the
trouble.





wrote:


On Feb 16, 7:23 pm, Dave Peterson wrote:

If you create a new test worksheet--brand new and populate it with test data,
does the routine work ok?

wrote:

<<snipped

Hi Debra,
Yes I do, when I run the macro that time I have only Main and
Customers only...and when the individual sheets are created data from
Columns C & D is
repeated from columns F & G respectively. This is what is going
wrong.
Thanks for your time and helpRashidKhan- Hide quoted text -

- Show quoted text -

Sorry a typo in the previous post...Data from C and D is repeated in F
and G respectively...
Thanks

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I created a brand new worksheet and run the code..
Unfortunately same result is given

Thanks for your time
RashidKhan

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hello Dave,
I run the routine and following lines is giving problem:

If rsp = 6 Then
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1").Offset(i, 0), _
Unique:=False
Else
myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=TempWks.Range("D1:D2"), _
CopyToRange:=wks.Range("A1"), _
Unique:=False
End If
When the above code is run the data from Columns C & D is repeated in
Columns F & G respectively on the individual sheets.
Thanks for your time and assistance

Rashid Khan



--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html

--

Dave Peterson