• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

After move macro from saved file to personal.xlsb-stuck on "Thisworkbook"

Dear Sir,

My code is here ..that created for extract data from database & make separate file but just required buyer nos only (not generate for all buyers in database) ... coded for my requirement by this forums by Mr. Picosta...(I will always be thankful him for that help)

this macro moved from saved file to personnel.xlsb..for make it globally usable that work any active sheet..

but its stuck..

Code:
Sub SavetoNewFile()

    Dim lrow, i As Integer
    Dim criteria As New Collection
    Dim c As range
   
   
    lrow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Row
   
       
ThisWorkbook.Sheets("sheet1").range("A1:W" & lrow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    ThisWorkbook.Sheets("sheet1").range(Cells(1, "X"), Cells(Rows.count, "X").End(xlUp)), Unique:=False
       
   
 
    For Each c In ThisWorkbook.Sheets("Sheet1").range("A2:A" & lrow)
        If c.EntireRow.Hidden = False And IsInCollection(c, criteria) = False Then
            criteria.Add c
            Debug.Print c
        End If
    Next c
   
    For i = 1 To criteria.count
        ThisWorkbook.Sheets("sheet1").range("A1:W" & lrow).AutoFilter Field:=1, Criteria1:=criteria(i)
        Workbooks.Add
        ThisWorkbook.Sheets("sheet1").range("A1:W" & lrow).Copy ActiveWorkbook.Sheets(1).Cells(1, 1)
    Next i
   
End Sub

Private Function IsInCollection(valToBeFound As Variant, coll As Variant) As Boolean

    Dim element As Variant
   
    On Error GoTo IsInCollectionError: 'Collection is empty
    For Each element In coll
        If element = valToBeFound Then
            IsInCollection = True
            Exit Function
        End If
    Next element
   
    Exit Function
   
IsInCollectionError:
    On Error GoTo 0
    IsInCollection = False

End Function

Macro stuck on

ThisWorkbook.Sheets("sheet1").range("A1:W" & lrow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
ThisWorkbook.Sheets("sheet1").range(Cells(1, "X"), Cells(Rows.count, "X").End(xlUp)), Unique:=False

may be saved file's modules, code transfer to other module can prevent to run?

is this macro only run for only for which its resided in file?

another point of future error can be raise.....
can we prevent from raise error after add new file to paste the data?
please also resolve "Thisworkbook" & "Active workbook" concept in this code.

how this code decide from which workbook to which workbook paste data after add new file?

I already convert thisworkbook to active workbook but failes..
is there need to establish Parent Child relation ?

can this macro need variables that hold
(1) "from workbook" and another variable that hold (2) "To workbook"
to copy data ?

I can not understand..

please resolve.

Regards,
Chirag
 
You should read the Activeworkbook and ActiveWorksheet names into variables and use those instead of Thisworkbook and Sheets("Sheet1")
 
Dear Sir,

Thanks for your reply.

Code should run any workbook-& any sheet-no matter its saved or not
so workbook name means saved workbook? or for unsaved "Book1" (or any number its represent now?

if ..source workbook ...already saved ...then full path require for source wb & after add new workbook

(unsaved) where to data will be paste...that's name can be "Book1" or
newly open workbook name...

hope you focus & give some hint..on this matter..

Regards,
Chirag Raval
 
Dear Sir,

Source data file can be varied after each an hour though its saved,
put the name of that every time its looks not good.

after construct ..code ..every time go to code-to change workbook-worksheet looks not suitable.

code should must be every time target active sheet as source data
& how can we target destination workbook-worksheet?.

this is confusing me. Please help
Regards,
Chirag
 
Hi ,

Please upload a workbook on which this macro can be run.

I assume that this workbook will be open when you run the macro.

Narayan
 
Dear Sir,

thanks for your reply...
here I attached same for your reference..

Regards,
Chirag Raval
 

Attachments

  • AUTO -ADVANCE FILTER-JUST CLIK & LISTED BUY SEPARATE FILE CHANDOO.ORG.xlsm
    24.4 KB · Views: 10
Dear sir.

some notable features of this code...

Whole cod written as this code always resides in main source , database file
But think that i am just paste this data from some others source & not saved yet..(of course its "Active Workbook" now & Workbook name suppose book7 ..(7th workbook after open excel application )
If assign "Active Workbook" to Workbook variable SWb

If I use in variable like
Dim Swb as workbook
Set Swb=active workbook
Do something....

the after through the code Add new workbook
now how can I paste data in newly created file
code?

How to copy paste old active to new active?

In this code there are no require to select something
On source file...

another matter is there are require variable
for "for each C..... (what is c ask by VBA)
require variable there...

Just require modification for We can perfectly tell application
What is source & what is destination.

in short...
if a 2 unsaved workbooks open, how to copy 1 to another?

Hope your suggestion ..
Regards
Chirag Raval
 
Dear Sir,

I Modify the code as my logic & as per suggestions received from this forum
as require to This Code Should be run in any active workbook-sheet..

Code:
Sub Final_Save_Desire_To_New_File()

    Dim lrow, i As Integer
    Dim criteria As New Collection
    Dim c As cell
      
    Dim swb As Workbook
    Dim acsht As Worksheet
      
Set swb = ActiveWorkbook
    Set acsht = ActiveSheet
  
   lrow = Workbooks("swb").Sheets("acsht").Cells(Rows.count, 1).End(xlUp).Row
  
 Workbooks("swb").Sheets("acsht").range("A1:S" & lrow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Workbooks("swb").Sheets("acsht").range(Cells(1, "U"), Cells(Rows.count, "U").End(xlUp)), Unique:=False

    For Each c In Workbooks("swb").Sheets("acsht").range("A2:A" & lrow)
               If c.EntireRow.Hidden = False And IsInCollection(c, criteria) = False Then
            criteria.Add c
                     Debug.Print c
        End If
    Next c
  
    For i = 1 To criteria.count
            Workbooks("swb").Sheets("acsht").range("A1:S" & lrow).AutoFilter Field:=1, Criteria1:=criteria(i)
            Workbooks.Add
        Workbooks("swb").Sheets("acsht").range("A1:S" & lrow).Copy ActiveWorkbook.Sheets(1).Cells(1, 1)
    Next i
  
End Sub

Private Function IsInCollection(valToBeFound As Variant, coll As Variant) As Boolean

    Dim element As Variant
  
    On Error GoTo IsInCollectionError: 'Collection is empty
    For Each element In coll
        If element = valToBeFound Then
            IsInCollection = True
            Exit Function
        End If
    Next element
  
    Exit Function
  
IsInCollectionError:
    On Error GoTo 0
    IsInCollection = False

End Function

but macro now stuck on above Red Bold Area
though I already declare & give control of Workbook & Worksheet to this variable, what's the problem in code now?


Hope your Co-Operation,

Regards,
Chirag Raval
 
Hi ,

See if this works :
Code:
Sub Final_Save_Desire_To_New_File()
    Dim swb As Workbook
    Dim acsht As Worksheet
    Dim c As Range
    Dim lrow As Long, i As Long
   
    Dim criteria As New Collection
           
    Set swb = ActiveWorkbook
    With swb
        Set acsht = .ActiveSheet
 
        With acsht
              lrow = .Cells(Rows.Count, 1).End(xlUp).Row
 
              .Range("A1:S" & lrow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
                                        .Range(Cells(1, "U"), Cells(Rows.Count, "U").End(xlUp)), Unique:=False

              For Each c In .Range("A2:A" & lrow)
                  If c.EntireRow.Hidden = False And IsInCollection(c, criteria) = False Then
                    criteria.Add c
                    Debug.Print c
                  End If
              Next c
 
              For i = 1 To criteria.Count
                  .Range("A1:S" & lrow).AutoFilter Field:=1, Criteria1:=criteria(i)
                  Workbooks.Add
                  .Range("A1:S" & lrow).Copy ActiveWorkbook.Sheets(1).Cells(1, 1)
              Next i
        End With
    End With
End Sub
Narayan
 
Hi ,

Use this revised code , which removes the filter , if any , before processing the data.
Code:
Sub Final_Save_Desire_To_New_File()
    Dim swb As Workbook
    Dim acsht As Worksheet
    Dim c As Range
    Dim lrow As Long, i As Long
   
    Dim criteria As New Collection
           
    Set swb = ActiveWorkbook
    With swb
        Set acsht = .ActiveSheet
 
        With acsht
              If .AutoFilterMode Then .Cells.AutoFilter
              lrow = .Cells(Rows.Count, 1).End(xlUp).Row
 
              .Range("A1:S" & lrow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
                                        .Range(Cells(1, "U"), Cells(Rows.Count, "U").End(xlUp)), Unique:=False

              For Each c In .Range("A2:A" & lrow)
                  If c.EntireRow.Hidden = False And IsInCollection(c, criteria) = False Then
                    criteria.Add c
                    Debug.Print c
                  End If
              Next c
 
              For i = 1 To criteria.Count
                  .Range("A1:S" & lrow).AutoFilter Field:=1, Criteria1:=criteria(i)
                  Workbooks.Add
                  .Range("A1:S" & lrow).Copy ActiveWorkbook.Sheets(1).Cells(1, 1)
              Next i
        End With
    End With
End Sub
Narayan
 
Dear Sir,

thanks...Code worked ... but files generate for all buyers... it can generate for only buyer no mentioned under Column "U" only

SOME POINTS CAN BE NOTABLE FOR RESOLVE..
(1) variable c as range added by me ...its not in code from where i got .
(due to macro demand what is c.. then I just declare as range ..
(2) lrow as long & I as long I modified from original code originally they
are declared as integer In That Code From Where I Got.

(3)function part... I not change anything...
(3) just added button on sheet (I will shift this "clik" mechanism in ribbon when macro run accurately)..pointing to this macro for require to stay on active sheet
can I find solution for just run for only Buyer No mentioned under column u?

Regards,
Chirag Raval
 
Dear Sir,
You are right ...but you can check after run it ...its generate for all buyers
what can be modify I can not understands.

I also upload here original file which run successful ..for just require buyer
but if reside code in that file module.

this whole thread created for code run should be any active file .

hope may be we are little far from the solution.

regards,
Chirag Raval
 

Attachments

  • AUTO -ADVANCE FILTER-JUST CLIK & LISTED BUY SEPARATE FILE CHANDOO.ORG.xlsm
    23.9 KB · Views: 4
Dear Sir,

I also attached here with your coded file which generate for all buyers.

Regards,
Chirag Raval
 

Attachments

  • TEST FOR SEPARATE FILES.xlsx
    19.7 KB · Views: 3
Dear Sir,

by mistake.... Above file attached without your Macro...
Re-attached Same with macro (Your Coded module in it)
for your referecne

I also convert it Excel Macro Enabled Work Book (.XLSM)

Regards,
Chirag
 

Attachments

  • WITH MODULE-TEST FOR SEPARATE FILES.xlsm
    19.7 KB · Views: 4
Hi ,

The header label for the criteria range must match the corresponding field header label in your data range.

If you are going to filter on the ID field , then the header label for the criteria range should be ID ; in your case , you want to filter on the first column whose header label is BUY ; your criteria range should also have its header label as BUY. If you use any other label , Excel cannot determine to which field the criteria should be applied.

Narayan
 
Dear Sir,

Amazing. ...i change just column "U" 's heading from "Criteria" to "Buy"
& miracle happen (can be Any Active sheet-Independently)..
macro runs for only desired buyers.....

How i can not Understand that little point..Oh Really feel guilty on my self... ...

thanks again ..this thread will not end without your help...
but now ...whole this thread found perfect solution..

Till now...My many problems you solved ...like a magic..
i will always respect you & appreciates for your help...

i will be always thankful for that.

& also sorry for disturb you sending many conversations.

but also ...little desire & hope... if in future ,
whenever if feel struggle in code related problem...
you can help me..

Thanks again for all you co-operations & this Organisation..

Regards,
Chirag
 
Dear All,

Some notes

THREAD-For Filtered Result Only-Each Unique Filtered Set Save as New file
BASICS HELP PROVIDED BY CHANDOO.ORG--
WORKING CODE PROVIDED BY "MR PCOSTA87" TO CHIRAG RAVAL THIS TASK SUCESSFULL THROUGH USE OF
""LOOP" & "COLLECTIONS"
ORIGNAL THREAD STATED AT
http://www.chandoo.org/forum/threads/for-filtered-result-only-each-unique-filtered-set-save-as-new-file.34572/
" IT CAN BE WORK ON ANY FILE" HELPED TO COMPLETE BY "MR.KNARAYANAN"
http://www.chandoo.org/forum/threads/after-move-macro-from-saved-file-to-personal-xlsb-stuck-on-thisworkbook.34610/#post-206615

Thanks
Chirag Raval
 
Dear All,

Remember now...Also many Thanks to Mr. Hui who first over view & give concept & direction for resolve this thread.

Regards
Chirag Raval
 
Dear Sir @NARAYANK991 ,

Now there are need to added some more criteria in continuation of this thread,
your code work like a charm on columns u which have buyer Nos.
but there are requirement separate file for buyer but "date > particular" , "Type is particular " I attached my same file with requirement as yellow highlighted



hope your co-operation,

Regards,
Chirag Raval
 

Attachments

  • FOR CHANDOO.ORG-REQUIRE SEPARAE FILES ONLY FOR FILTERED UNIQUE RESULT'S SET (1).xlsm
    24.9 KB · Views: 5
Last edited:
Dear All,

Buyer Wise separate file ...Code run ok...(Code is in my attached excel file) but require to added 2 more criteria in this ..as per above my post no 20...

Requirement
(1) Buyer wise separate file ...(that's already done by code inside attached file created based on advance filter & collection +Dic) ) but with particular Confirmation date & particular type wise ....
(2) if buyer no not given then particular mentioned date or between date wise, & type wise
(3) if buyer & date not mentioned then particular type wise

in short require separate file for all 3 or any given criteria out of 3

how can it can be done?

hope there are some way there to done this.

Regards,
Chirag Raval
 
Dear all experts,

Can any one helop regardibg this?
If I added many buyers & related multi criteria for each buyer related criteria under columns
U , V & W, can separate files generate for all buyers mentioned under
Column U ?

There are need formula under column U to cover all criteria
With its right 2 columns?

If formuka under column U then its conflicts with the
Rune that if criteria is formula then we should not put
Heading & our code run for each buyer nos under U.

How to handle situation of code that cover 3 columns
Criteria? How to expand criteria range for each unique
3 columns?

CanCan any one help from here?

Hope your cooperation.

Regards,

Chirag Raval
 
Dear Sir,

Please see this requirement as an image and also attached file for the same.



Hope you can understand & little help to modify code as requirement.

Regards,
Chirag Raval
 

Attachments

  • FOR CHANDOO.ORG-REQUIRE SEPARAE FILES ONLY FOR FILTERED UNIQUE RESULT'S SET (1) (1).xlsm
    25 KB · Views: 0
Dear Sirs,

I already try below multi adjustment in code ..But Its fail..

Code:
With acsht
              If .AutoFilterMode Then .Cells.AutoFilter
              LRow = .Cells(Rows.count, 1).End(xlUp).Row
 
'              .range("A1:W" & LRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
'              .range(Cells(1, "Y"), Cells(Rows.count, "Y").End(xlUp)), Unique:=False
                         
    'Sheet1.range("A1", Sheet1.range("M" & Rows.count).End(xlUp)).AdvancedFilter 2, Sheet2.[U1:X4], [a10]
'      Sheet1.range("A1:S" & LRow).AdvancedFilter 1, Sheet1.[U1:X4], [A2]
    Sheet1.range("A1:S" & LRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    .range("U1", Cells(Rows.count, "X").End(xlUp)), Unique:=False
                                                                                 
                        On Error GoTo DisplayError
                                       
              For Each cell In .range("A2:A" & LRow)
             
              If Not IsError(cell) Then
                  If cell.EntireRow.Hidden = False And IsInCollection(cell, criteria) = False Then
                    criteria.add cell
                    Debug.Print cell
                  End If
                  End If
              Next cell

Please do needful.

Regards,
Chirag Raval
 
Dear all Experts,

So now only must be drop formula under column U is
Can be solution of my answer?

Please just reply as a just guideline. So I can struggle
Through that way....I try till last week but can not suces
Please Gide for how formula"s End result can work?
What type of end? As a number?, or string ? Or variant?
Or may be some more require?.

Please help.

Regards,

Chirag Raval
 
Back
Top