Help Needed - Excel data and Running queries

[komarag]

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.

[Bob Phillips]

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

[komarag]

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...

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

[Bob Phillips]

You now need to assign the macro to the button on your duplicates sheet.

[Ken Puls]

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.

[Bob Phillips]

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.

He already did, he just needs to assign the macro to it.

[Ken Puls]

Doh! (I didn't actually open the file.)

[komarag]

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.

[komarag]

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...

[Ken Puls]

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

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.