Results 1 to 2 of 2

Thread: Pick up data based on conditions

  1. #1

    Post Pick up data based on conditions



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi All,
    I need to automate below task. I have multiple sheets where team where team memberís achievements mentioned. In sample workbook I have added 2 sheets only however I have around 10 to 15 sheets in actual. I need to build matrix where below things should come up.


    1. If any team member have achievement then only macro or formula should pick up data (Please refer column Achievements)
    2. If achievement in same or in same month or in same date it should NOT skip. It must appear in output data
    3. In raw data (Sheet DR & TL)columns can be changed hence it should not affect our result


    Please refer attached workbook for the same. Please help me how can solve this issue.
    Attached Files Attached Files

  2. #2
    Code:
    Public Sub MergeData()
    Dim ws As Worksheet
    Dim col As Long
    Dim lastrow As Long
    Dim nextrow As Long
    Dim i As Long
        
        Application.ScreenUpdating = False
        
        With ActiveWorkbook
            
            Application.DisplayAlerts = False
            On Error Resume Next
            .Worksheets("Achievements").Delete
            On Error GoTo 0
            Application.DisplayAlerts = True
            .Worksheets.Add after:=.Worksheets(.Worksheets.Count)
            ActiveSheet.Name = "Achievements"
            ActiveSheet.Range("A1:C1").Value = Array("OWNER", "Achievements/Milestone", "Date")
            
            nextrow = 2
            For Each ws In .Worksheets
        
                If ws.Name <> "Achievements" Then
                
                    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                    col = Application.Match("OWNER", ws.Rows(1), 0)
                    ws.Cells(2, col).Resize(lastrow - 1).Copy ActiveSheet.Cells(nextrow, "A")
                    col = Application.Match("Achievements/Milestone", ws.Rows(1), 0)
                    ws.Cells(2, col).Resize(lastrow - 1).Copy ActiveSheet.Cells(nextrow, "B")
                    col = Application.Match("Date", ws.Rows(1), 0)
                    ws.Cells(2, col).Resize(lastrow - 1).Copy ActiveSheet.Cells(nextrow, "C")
                    col = Application.Match("Achievements", ws.Rows(1), 0)
                    ws.Cells(2, col).Resize(lastrow - 1).Copy ActiveSheet.Cells(nextrow, "D")
                    nextrow = nextrow + lastrow - 1
                End If
            Next
            
            With ActiveSheet
                
                lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
                For i = lastrow To 2 Step -1
                
                    If .Cells(i, "D").Value <> "YES" Then
                    
                        .Rows(i).Delete
                    End If
                Next i
                
                .Columns("A:C").ColumnWidth = 20
                .Columns("D").Delete
            End With
        End With
        
        Application.ScreenUpdating = True
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •