Previous Topic Next Topic

Multiple criteria

Closed
Peter - Apr 28, 2010 at 04:33 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - May 19, 2010 at 11:10 AM
Hi,

I am trying to perform this for several criteria and I only want to return the detail in a specific column of the source data sheet (say detail in column A). Also, I notice that when the existing code is run, the data is split out into referenced sheets (as desired), but there are empty rows where data did not meet criteria.

I am referring to thread, "Copy rows based on a condition".

Thanks for you help,

Peter

3 responses

Answer 1 / 3
Peter
Apr 28, 2010 at 04:34 AM
I am referring to thread, "Copy rows based on a condition".
0
Answer 2 / 3
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Apr 28, 2010 at 11:21 AM
That thread has too many cooks and solutions. Perhaps time to reset. Could you please upload a sample file with sample data etc on some shared site like https://authentification.site and post back here the link to allow better understanding of how it is now and how you foresee.
0
Peter
Apr 30, 2010 at 10:03 AM
Hi rizvisa1,

That site has been blocked by my organisation. I will upload a sample of what I am looking for later.

I will give you a simple example to help explain what I am trying to do;
Consider a scenario where you have one tab containing a list of people by job title (with other data). All other tabs in the workbook are templates for the job titles of interest - with v-lookups to pull back the appropriate information for each.
What I need to do is; populate column A of the relevent job title templates with peoples names, according to their job title so that the other fields in the template can pull in the rest of the information.

Any ideas of how I should proceed? Thanks for your prompt response.

Peter
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Apr 30, 2010 at 11:47 AM
I am one of those people from whom picture speaks louder than the words. I was not able to comprehend all that you said. From what I understand, I would say you would need a user defined function to do a sort of look up.
0
Peter - same guy
May 13, 2010 at 03:05 AM
Hi Rzvisa,

As suggested, I have attached the sample to: https://authentification.site/files/22403075/sample_excel_query.xls

The detail outlined above should make sense when you see the example.

Thanks again,

Peter
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
May 13, 2010 at 06:42 AM
What if you have a John who is a baker and a john who is a plumber
0
peter
May 13, 2010 at 08:35 AM
Luckily cannot happen - there will only ever be one John ;-)
0
Answer 3 / 3
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
May 14, 2010 at 05:22 PM
Purpose:Take data from master sheet and create/append to based on unique values from a column in master sheet


Assumptions:
1. Master sheet is called "List". (Change in the code if the name is different)

2. On Master sheet and other sheets, the data starts from row2 and contains the column headers. (Change in the code its is not the case)

3. The unique value based on which data will be cut is used to name the sheets where the data related to that value is to be copied from master.

4. If the sheet where the data is to copied/cut exists, then append to the existing data. (Change in the code its is not the case)

4. If the cut sheet/report does not exists all column are to be copied from master sheet.

5. If the cut sheet/report does exists, only the columns that exist on cut sheet would be copied from master sheet.

Steps:
1. Read the assumptions
2. Make a backup copy of the file
3. Press ALT + F11 to start VBE
4. Click on insert and add a new module
5. Paste the code given below
6. Run the macro 

Sub MoveDataFromMasterToValueBasedSheet()
' Syed Asad Ali Rizvi
' Version 2.0
Dim sMasterSheet As String 'name of the master sheet
Dim iBasedOnColumn As Integer 'column number based on which sheets are to be generated
Dim bReplace As Boolean ' should new sheet be generated for item based on which data is cut
Dim lHeaderRowLocation As Long ' first used row which should be the header row too

Dim lMaxUniqueValueCount As Long 'number of unique items on which sheets are to be generated
Dim iUniqueItemProcess As Long ' unique item count that is being processed
Dim sUniqueValue As String ' the value for which the sheet is being generated


Dim bFreshSheet As Boolean ' fresh sheet was created for item
Dim sTempSheet As String 'name of a temp sheet for purpose of working
Dim sTempSheet2 As String 'temp sheet to compare columns in source and target
Dim lResultSheet As Long 'number of rows in the new sheet
Dim iFilterCol As Integer 'location of columns on master sheet
Dim iResultCol As Integer 'location of column on target sheet

Dim bScreenUpdating As Boolean 'current status of screen updating
Dim bDisplayAlerts As Boolean ' show show warnings

    bScreenUpdating = Application.ScreenUpdating
    bDisplayAlerts = Application.DisplayAlerts
    
    On Error GoTo Error_Handle
    
    Application.ScreenUpdating = False
    
    
    ' ===============================================
    ' ######### CUSTOMIZATION START HERE ############
    
    sMasterSheet = "List" ' master sheet
    iBasedOnColumn = 2 ' unique items on which data would be cut is would on master sheet in this column
    lHeaderRowLocation = 2 'the row on which the header row is found and is common to all sheets
    bReplace = False 'should data be cut on new sheets if sheet is present?    
    ' ######### CUSTOMIZATION END HERE #############
    ' ===============================================
    
    sTempSheet = "tempsheet" ' temp sheet for unique listing based on which sheets would be populated
    sTempSheet2 = "tempsheet2" '

    bFreshSheet = False ' if data was not to be cut on new sheet, was this sheet created as it was not present
    
    On Error Resume Next
        If bDisplayAlerts Then Application.DisplayAlerts = False
        Sheets(sTempSheet).Delete
        If (Not bReplace) Then Sheets(sTempSheet2).Delete
         If bDisplayAlerts Then Application.DisplayAlerts = True
    On Error GoTo Error_Handle
    
    Sheets.Add
    ActiveSheet.Name = sTempSheet
    
    Sheets(sMasterSheet).Select
    
    If ActiveSheet.AutoFilterMode Then
        Cells.Select
        
        On Error Resume Next
        
        ActiveSheet.ShowAllData
        
        On Error GoTo Error_Handle
    
    End If
    
    Columns(iBasedOnColumn).Select
    Selection.Copy
    
    Sheets(sTempSheet).Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    If (Cells(1, 1) = "") Then
        lastrow = Cells(1, 1).End(xlDown).Row
        
        If lastrow <> Rows.Count Then
            Range("A1:A" & lastrow - 1).Select
            Selection.Delete Shift:=xlUp
        End If
    
    End If
    
    Columns("A:A").Select
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
    
    Columns("A:A").Delete
    
    Cells.Select
    Selection.Sort _
                Key1:=Range("A2"), Order1:=xlAscending, _
                Header:=xlYes, OrderCustom:=1, _
                MatchCase:=False, Orientation:=xlTopToBottom
    'DataOption1:=xlSortNormal,
    lMaxUniqueValueCount = Cells(Rows.Count, 1).End(xlUp).Row
    
    If (Not bReplace) Then
        Sheets.Add
        ActiveSheet.Name = sTempSheet2
        Sheets(sMasterSheet).Select
        Range(Cells(lHeaderRowLocation, 1), Cells(lHeaderRowLocation, Columns.Count)).Copy
        Sheets(sTempSheet2).Range("A1").PasteSpecial Transpose:=True
        
    End If
    
    For iUniqueItemProcess = 2 To lMaxUniqueValueCount
    
        sUniqueValue = Sheets(sTempSheet).Range("A" & iUniqueItemProcess)
        bFreshSheet = False
        If sUniqueValue <> "" Then
        
            On Error Resume Next
                Err.Clear
                Sheets(sUniqueValue).Select
            On Error GoTo Error_Handle
                
            If ((ActiveSheet.Name <> sUniqueValue) Or (bReplace)) Then
                
                On Error Resume Next
                    If bDisplayAlerts Then Application.DisplayAlerts = False
                    Sheets(sUniqueValue).Delete
                    If bDisplayAlerts Then Application.DisplayAlerts = True
                On Error GoTo Error_Handle
                
                Err.Clear
                Sheets.Add
                ActiveSheet.Name = sUniqueValue
                Sheets(sUniqueValue).Range(lHeaderRowLocation & ":" & lHeaderRowLocation) = Sheets(sMasterSheet).Range(lHeaderRowLocation & ":" & lHeaderRowLocation).Value
                bFreshSheet = True
                
            End If
            
            If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
            lResultSheet = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lResultSheet = lResultSheet + 1
            Cells(lResultSheet, "A").Select
            
            Sheets(sMasterSheet).Select
            Range(Cells(lHeaderRowLocation, 1), Cells(Rows.Count, Columns.Count)).Select
            
            If ActiveSheet.AutoFilterMode = False Then
                Selection.AutoFilter
            End If
            
            Selection.AutoFilter Field:=iBasedOnColumn, Criteria1:="=" & sUniqueValue, Operator:=xlAnd, Criteria2:="<>"
            
            lastrow = Cells(Rows.Count, iBasedOnColumn).End(xlUp).Row
            
            If (lastrow > lHeaderRowLocation) Then
            
                If bFreshSheet Then
                    Rows(lHeaderRowLocation + 1 & ":" & lastrow).Copy
                    Sheets(sUniqueValue).Range("A" & lResultSheet).PasteSpecial
                Else
                
                    lResultSheet = Sheets(sUniqueValue).Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    lResultSheet = lResultSheet + 1
                    Sheets(sUniqueValue).Select
                    Range(Cells(lHeaderRowLocation, 1), Cells(lHeaderRowLocation, Columns.Count)).Copy
                    Sheets(sTempSheet2).Select
                    Sheets(sTempSheet2).Range("B1").PasteSpecial Transpose:=True
                    iResultCol = Cells(Rows.Count, "B").End(xlUp).Row
                    
                    Do While (iResultCol > 0)
                        iFilterCol = 0
                        
                        On Error Resume Next
                        iFilterCol = WorksheetFunction.Match(Sheets(sTempSheet2).Cells(iResultCol, "B"), Sheets(sTempSheet2).Range("A1:A" & Rows.Count), 0)
                        On Error GoTo Error_Handle
                        
                        If (iFilterCol > 0) Then
                            Sheets(sMasterSheet).Select
                            Range(Cells(lHeaderRowLocation + 1, iFilterCol), Cells(lastrow, iFilterCol)).Copy
                            Sheets(sUniqueValue).Select
                            Cells(lResultSheet, iResultCol).Select
                            ActiveSheet.PasteSpecial
                            
                            
                        End If
                        
                        iResultCol = iResultCol - 1
                        
                    Loop
                    
                    Sheets(sUniqueValue).Select
                    Cells(lResultSheet, 1).Select
                End If
                
            End If
        End If
    
    Next
    
    If bDisplayAlerts Then Application.DisplayAlerts = False
        Sheets(sTempSheet).Delete
        If (Not bReplace) Then Sheets(sTempSheet2).Delete
    If bDisplayAlerts Then Application.DisplayAlerts = True
    
    Sheets(sMasterSheet).Select
    If ActiveSheet.AutoFilterMode Then
        Cells.Select
        ActiveSheet.ShowAllData
    End If

    GoTo End_Sub
    
Error_Handle:

    MsgBox Err.Description
    
End_Sub:

    Application.ScreenUpdating = bScreenUpdating
    Application.DisplayAlerts = bDisplayAlerts
    
End Sub
0
Peter O'C
May 19, 2010 at 11:05 AM
Thanks for posting. I ran the macro on the sheet and found that there was duplication to some extent - i.e. some names appeared in tabs when they shouldn't have.

Any idea why this would have happened?

Thanks,

Peter
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
May 19, 2010 at 11:10 AM
Have to see to tell you. It should not have been like that
0

Similar discussions

Excel - IF function with multiple words
Nick -
user -

14 responses
If cell contains multiple text how to add other cell value?
Iza -
TrowaD -

1 response
How to re/name a cell if another cell contains X
Alexzandeur -
vcoolio -

5 responses
Can’t Log into Instagram from Multiple Devices
Isabella -
Abhishek0025 -

5 responses
Code for macro that conditionally inserts rows
bfleming -
bfleming -

4 responses