Help Needed - Excel data and Running queries

K

komarag

New member
Joined
Aug 9, 2011
Messages
26
Reaction score
0
Points
0
Hi, all

I can't use access or any other SQL tools...need to develop this in Excel only.

I am new to the Excel VBA programming. I have an excel sheet (single worksheet) with data. The data is getting refreshed from sharepoint list. I am using 2010 version of Excel.

Once the data is refreshed, I would like to run some queries on the refreshed worksheet.

for example, the excel sheet has the following columns

Package id
Date1
Date2
Date3
ingredient
ingredient type


I am planning to have queries that can run on this data in excel to provide a subset of rows that meets the criteria... The query results must be stored in new worksheet in the same document.

1. to find the duplicate ingredients by ingredient

attached the test data and expected results in different tab. appreciate your help.

Either macro or vba code help.
 

Attachments

  • test1.xlsx
    13.1 KB · Views: 21
Code: 
Public Function DuplicateData()Dim ws As Worksheet
Dim current As String
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long


    Set ws = Worksheets("duplicates")
    With ws
    
        .UsedRange.ClearContents
        .Range("A3:E3").Value = Array("Ingredient", "Date 1", "Date 2", "Date 3", "package")
    End With


    Worksheets("master data").Copy AFter:=Worksheets(Worksheets.Count)
    With ActiveSheet
    
        .Name = "temp"
        .Range("G1").Value = "Flag"
        
        nextrow = 4
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("G2").Resize(lastrow - 1).Formula = _
            "=IF(COUNTIF(E$1:E2,E2)>1,INDEX(G$1:G1,MATCH(E2,E$1:E1,0)),MAX(G$1:G1)+1)"
        .Columns("A:G").Sort key1:=Range("G2"), order1:=xlAscending, Header:=xlYes


        For i = 2 To lastrow
        
            If Application.CountIf(.Columns("E"), .Cells(i, "E").Value) > 1 Then
            
                current = .Cells(i, "E").Value
                ws.Cells(nextrow, "A").Value = current
                Do While .Cells(i, "E").Value = current


                    .Cells(i, "B").Resize(, 3).Copy ws.Cells(nextrow, "B")
                    .Cells(i, "A").Copy ws.Cells(nextrow, "E")
                    nextrow = nextrow + 1
                    i = i + 1
                Loop
                
                nextrow = nextrow + 1
                i = i - 1
            End If
        Next i
    End With
    
    Application.DisplayAlerts = False
    Worksheets("temp").Delete
End Function
 
Thanks, Bob for the code.

can you provide steps in incorporting this code....I opened VB editor...and copied the code...saved the file...

As I said before, I am newbie to the VBA code and how to run this...



Bob Phillips said:
Code: 
Public Function DuplicateData()Dim ws As Worksheet
Dim current As String
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long


    Set ws = Worksheets("duplicates")
    With ws
    
        .UsedRange.ClearContents
        .Range("A3:E3").Value = Array("Ingredient", "Date 1", "Date 2", "Date 3", "package")
    End With


    Worksheets("master data").Copy AFter:=Worksheets(Worksheets.Count)
    With ActiveSheet
    
        .Name = "temp"
        .Range("G1").Value = "Flag"
        
        nextrow = 4
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("G2").Resize(lastrow - 1).Formula = _
            "=IF(COUNTIF(E$1:E2,E2)>1,INDEX(G$1:G1,MATCH(E2,E$1:E1,0)),MAX(G$1:G1)+1)"
        .Columns("A:G").Sort key1:=Range("G2"), order1:=xlAscending, Header:=xlYes


        For i = 2 To lastrow
        
            If Application.CountIf(.Columns("E"), .Cells(i, "E").Value) > 1 Then
            
                current = .Cells(i, "E").Value
                ws.Cells(nextrow, "A").Value = current
                Do While .Cells(i, "E").Value = current


                    .Cells(i, "B").Resize(, 3).Copy ws.Cells(nextrow, "B")
                    .Cells(i, "A").Copy ws.Cells(nextrow, "E")
                    nextrow = nextrow + 1
                    i = i + 1
                Loop
                
                nextrow = nextrow + 1
                i = i - 1
            End If
        Next i
    End With
    
    Application.DisplayAlerts = False
    Worksheets("temp").Delete
End Function
Click to expand...
 
You now need to assign the macro to the button on your duplicates sheet.
 
To create the button, look for the top left button on the Developer-->Controls-->Insert

As soon as you drop the button on the worksheet it will pop up a dialog asking you to assign the macro to it.
 
Ken Puls said:
To create the button, look for the top left button on the Developer-->Controls-->Insert

As soon as you drop the button on the worksheet it will pop up a dialog asking you to assign the macro to it.
Click to expand...

He already did, he just needs to assign the macro to it.
 
Thanks, Ken and Bob for your prompt help.

I am getting the following errro when I am running...ran it in debug mode .

Attached the excel sheet for your review and help.
 

Attachments

  • Capture1.JPG
    Capture1.JPG
    26.1 KB · Views: 14
  • test1-A.xlsm
    22.8 KB · Views: 14
working now...I think

Let me give u an update tomorrow...if that doesn't work. Thanks again to Bob for the macro code.

do u suggest any good book for learning VBA? i am sure , I will learn lot by reading the forums on this site...
 
komarag said:
do u suggest any good book for learning VBA? i am sure , I will learn lot by reading the forums on this site...
Click to expand...

I've always been a big fan of John Walkenbach's Power Programming With VBA book. I just about wore out the spine in my copy. That, coupled with a good forum, will take you miles.
 
I just found a small but can be significant missing qualification in the code. This is better

Code: 
Public Function DuplicateData()
Dim ws As WorksheetDim current As String
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long

    Set ws = Worksheets("duplicates")
    With ws
    
        .UsedRange.ClearContents
        .Range("A3:E3").Value = Array("Ingredient", "Date 1", "Date 2", "Date 3", "package")
    End With

    Worksheets("master data").Copy AFter:=Worksheets(Worksheets.Count)
    With ActiveSheet
    
        .Name = "temp"
        .Range("G1").Value = "Flag"
        
        nextrow = 4
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("G2").Resize(lastrow - 1).Formula = _
            "=IF(COUNTIF(E$1:E2,E2)>1,INDEX(G$1:G1,MATCH(E2,E$1:E1,0)),MAX(G$1:G1)+1)"
        .Columns("A:G").Sort key1:=.Range("G2"), order1:=xlAscending, Header:=xlYes

        For i = 2 To lastrow
        
            If Application.CountIf(.Columns("E"), .Cells(i, "E").Value) > 1 Then
            
                current = .Cells(i, "E").Value
                ws.Cells(nextrow, "A").Value = current
                Do While .Cells(i, "E").Value = current

                    .Cells(i, "B").Resize(, 3).Copy ws.Cells(nextrow, "B")
                    .Cells(i, "A").Copy ws.Cells(nextrow, "E")
                    nextrow = nextrow + 1
                    i = i + 1
                Loop
                
                nextrow = nextrow + 1
                i = i - 1
            End If
        Next i
    End With
    
    Application.DisplayAlerts = False
    Worksheets("temp").Delete
End Function
 
Last edited:
Thanks, Bob

How can I write the following code from a range to individual items?

.Cells(i, "B").Resize(, 3).Copy ws.Cells(nextrow, "B")
.Cells(i, "A").Copy ws.Cells(nextrow, "E")

for example, currently i am asking the report in the format of
date 1 , date 2 and date 3 as it is given in the sequence...

What if I want the data in date 3, date 1 and date 2.

I orderded the book and so that I can understand the syntax better so that I can make changes by myself. Is it possible to provide an explantion to the code on what it is doing at a very high level....

Bob Phillips said:
I just found a small but can be significant missing qualification in the code. This is better

Code: 
Public Function DuplicateData()
Dim ws As WorksheetDim current As String
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long

    Set ws = Worksheets("duplicates")
    With ws
    
        .UsedRange.ClearContents
        .Range("A3:E3").Value = Array("Ingredient", "Date 1", "Date 2", "Date 3", "package")
    End With

    Worksheets("master data").Copy AFter:=Worksheets(Worksheets.Count)
    With ActiveSheet
    
        .Name = "temp"
        .Range("G1").Value = "Flag"
        
        nextrow = 4
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("G2").Resize(lastrow - 1).Formula = _
            "=IF(COUNTIF(E$1:E2,E2)>1,INDEX(G$1:G1,MATCH(E2,E$1:E1,0)),MAX(G$1:G1)+1)"
        .Columns("A:G").Sort key1:=.Range("G2"), order1:=xlAscending, Header:=xlYes

        For i = 2 To lastrow
        
            If Application.CountIf(.Columns("E"), .Cells(i, "E").Value) > 1 Then
            
                current = .Cells(i, "E").Value
                ws.Cells(nextrow, "A").Value = current
                Do While .Cells(i, "E").Value = current

                    .Cells(i, "B").Resize(, 3).Copy ws.Cells(nextrow, "B")
                    .Cells(i, "A").Copy ws.Cells(nextrow, "E")
                    nextrow = nextrow + 1
                    i = i + 1
                Loop
                
                nextrow = nextrow + 1
                i = i - 1
            End If
        Next i
    End With
    
    Application.DisplayAlerts = False
    Worksheets("temp").Delete
End Function
Click to expand...
 
Also, In addition to the above criteria, How can I retrieve the data based on date range? I would like to input the dates and run the query....
 
Sorry, I am not clear what you changes you want to add

Code: 
Public Function DuplicateData()Dim ws As Worksheet
Dim current As String
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long

    [COLOR=#008000]'set a worksheet variable to the duplicates worksheet[/COLOR]
    Set ws = Worksheets("duplicates")
   [COLOR=#009933] 'and then use it[/COLOR]
    With ws
    
       [COLOR=#009933] 'remove any data on the sheet[/COLOR]
        .UsedRange.ClearContents
        [COLOR=#009933]'insert the headings in row 3 - avoid the button[/COLOR]
        .Range("A3:E3").Value = Array("Ingredient", "Date 1", "Date 2", "Date 3", "package")
    End With

    '[COLOR=#009933]copy the master data sheet as we will change it and we don't want
    '   mess with the original[/COLOR]
    Worksheets("master data").Copy AFter:=Worksheets(Worksheets.Count)
   [COLOR=#009933] 'with the new sheet ...[/COLOR]
    With ActiveSheet
    
        [COLOR=#009933]'rename it to temp[/COLOR]
        .Name = "temp"
        [COLOR=#009933]'we will populate  column G, so give it a heading of 'Flag'[/COLOR]
        .Range("G1").Value = "Flag"
        
        [COLOR=#009933]'nextrow will be used for the output so start at 4 (headings in row 3)[/COLOR]
        nextrow = 4
        [COLOR=#009933]'lastrow is used to work out the last row of data[/COLOR]
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        [COLOR=#009933]'now we add a formula into all rows in column G, the formula assigns an
        '   index number for each unique value in column E[/COLOR]
        .Range("G2").Resize(lastrow - 1).Formula = _
            "=IF(COUNTIF(E$1:E2,E2)>1,INDEX(G$1:G1,MATCH(E2,E$1:E1,0)),MAX(G$1:G1)+1)"
        [COLOR=#009933]'we then sort this temp worksheet by this index (group all same names, but keep
        '   the overall order)[/COLOR]
        .Columns("A:G").Sort key1:=.Range("G2"), order1:=xlAscending, Header:=xlYes

       [COLOR=#009933] 'now we the data in order we output these making sure that we don't
        '   repeat the ingedient on each row[/COLOR]
        For i = 2 To lastrow
        
            If Application.CountIf(.Columns("E"), .Cells(i, "E").Value) > 1 Then
            
                [COLOR=#009933]'this puts the ingedient in column A[/COLOR]
                current = .Cells(i, "E").Value
                ws.Cells(nextrow, "A").Value = current
                [COLOR=#009933]'then we lopp through all rows for this ingredient outputting
                '   each set of details on a new row (nextrow)[/COLOR]
                Do While .Cells(i, "E").Value = current

                    .Cells(i, "B").Resize(, 3).Copy ws.Cells(nextrow, "B")
                    .Cells(i, "A").Copy ws.Cells(nextrow, "E")
                    nextrow = nextrow + 1
                    i = i + 1
                Loop
                
                [COLOR=#009933]'increment nextrow so as to force a blank between each set[/COLOR]
                nextrow = nextrow + 1
               [COLOR=#009933] 'decrement i as it will auto-increment at the Next statement[/COLOR]
                i = i - 1
            End If
        Next i
    End With
    
    [COLOR=#009933]'delete the temp worksheet, we are done with it[/COLOR]
    Application.DisplayAlerts = False
    Worksheets("temp").Delete
End Function
 
Last edited:
thanks, Bob

Please refer to the attachment...worksheet "by Date". The expected report format is given in that sheet.
The user enters a value and clicks the "Filter Master data by date". The macro must read the entire "master data" worksheet and filter by "Date1" column with the Input date value....The report has control break on Ingredient....No need to show the Date1 field in the column...only Date 2 and Date 3.

FYI..I tried to record the marco using the recorder...attached the code to the button in "by date".
 

Attachments

  • test1-A.xlsm
    31.8 KB · Views: 8
You must log in or register to reply here.
Back
Top