Script isn't copying all values in the criteria correctly and need help displaying

Hi Guys,

I'd really appreciate your help.

Quote:

---

Aim Report Manager Data - contains total jobs submitted
Google Data - Contains issues that occurred after the job was submitted

:IF Column X = "Event 6: QA Finished" And Column Y Contains USER 1 then Copy active row cells Y, AA and AE to worksheet User 1 (Cells A2-C2) and a loop for all of User 1's jobs then do the next (example User 2 to worksheet 2) till all the users information is in their specific sheets.

The next step would be to go through the WorkSheets (Users1 till last User)
and check the following Criteria:


IF B2 from WorkSheet User 1 is present in column J in Google Data and C2 is present in Column X ( IF both criteria match) Copy active row to A4:X4 and loop till all issues are listed.


Then go to worksheet 2 User 2 and follow the same criteria.

---

At the moment bits of the above are working but not fully functioning correctly. As you can see below the issues that remain are :

For the names of the users; at the moment I've kept them as initials but for the final report they will be full names.
The total number of worksheets would depend on the number of users that are in the criteria. (this can vary, there is no set number)

1) At the moment when you run the script it is only listing one defect number per project id (Google Data) would it be possible to list all the defects for each project done by that user and have them copied to the worksheet with the user name.

Example : User YA did project "ayca-h8qsj" AND "TTFN"
there are 2 defects within the google data (6759 and 6762) however at the moment the script is only bringing 6762. Most projects have multiple defects and need to be listed.

Also would it be possible to:

2) have the end result formatted automatically ? Basically a bit more spaced out and presented (Example attached)Please note all cells are auto fit to format and column O is text wrapped. (Refer to WorkSheet LK in the attached)

Thanks so much for helping me out on this.

Thanks in advance,

Hi Guys,

Would it be possible to have some advice on the above?

thanks

Hi Guys,

Would anyone be able to help me with the above ?

as you have not posted the code you have so far, it is hard to suggest improvements or fixes

i am unable to open your workbook, so can only go by what is in your posts
there are probably several methods to achieve your desired results, but without sample data

possibly sort the data containing the users, then work through all of each user and copy the matching criteria to other sheets

while most can now open later workbooks, i can only open .xls

Hi Westconn1,

Thanks for your response. These are the scripts within the sheets.

• Ribbon X Code - (i dont think this ones used for this report)

Code:

---

'Entry point for RibbonX button clickSub ShowATPDialog(control As IRibbonControl)
    Application.Run ("fDialog")
End Sub


'Callback for RibbonX button label
Sub GetATPLabel(control As IRibbonControl, ByRef label)
    label = ThisWorkbook.Sheets("RES").Range("A10").Value
End Sub

---

• Module 1

Code:

---

Sub Test1()End Sub


Sub activateSheet(sheetname As String)
'activates sheet of specific name
    Worksheets("Report Manager Data").Activate


If Range("X2:X541") = "Event 6: QA Finished" Then


'select


End Sub

---

• Report Manager Data
• Code:

  ---

  Private Sub CommandButton1_Click()



 Dim a, i As Long, j As Long, NR As Long, LR&, ws As Worksheet, x
 
 Application.ScreenUpdating = 0
 
 For Each ws In ThisWorkbook.Worksheets
        If Len(ws.Name) = 2 Or ws.Name = "SuDP" Then
            ws.Cells.ClearContents
        End If
    Next
With Worksheets("Report Manager Data")
    a = .Range("X1:AE" & .Cells.Find("*", , , , xlByRows, xlPrevious).Row)
 End With


 For i = 2 To UBound(a)
 
    If a(i, 1) = "Event 6: QA Finished" Then
   
        If Not Evaluate("ISREF('" & a(i, 2) & "'!A1)") Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = a(i, 2)
        End If
       
        With Worksheets(a(i, 2))
            NR = .Cells(Rows.Count, "a").End(xlUp).Row + 1
              .Cells(NR, 1) = a(i, 2)
              .Cells(NR, 2) = a(i, 4)
              .Cells(NR, 3) = a(i, 8)
        End With
    End If
 Next
 Call matchData
  Application.ScreenUpdating = True
End Sub


Sub matchData()


 Dim i&, j&, Diccol As Object, k As Long, x, a, n&, ws As Worksheet, TT
 
  Set Diccol = CreateObject("Scripting.Dictionary")
 
    With Worksheets("Google Data")
        x = .Range("A1:X" & .Cells.Find("*", , , , xlByRows, xlPrevious).Row)
    End With
  With Diccol
      For k = 2 To UBound(x)
      TT = Join$(Array(x(k, 10), x(k, 24)))
        .Item(TT) = k
      Next k
  End With
 


  For Each ws In ThisWorkbook.Worksheets
 
        With ws
       
            If Len(.Name) = 2 Or .Name = "SuDP" Then
           
                a = .Range("A2").CurrentRegion
               
                  If .Cells(.Rows.Count, 1).End(xlUp).Row - 1 = 0 Then Exit For
                 
                    With Diccol
           
                        ReDim y(1 To UBound(x, 1), 1 To UBound(x, 2))
                       
                        For i = 1 To UBound(a)
                        TT = Join$(Array(a(i, 2), a(i, 3)))
                             
                                If .Exists(TT) Then
                                n = .Item(TT)
                                      For j = 1 To UBound(x, 2)
                                            y(i, j) = x(n, j)
                                      Next
                                End If
                        Next i
                    End With
                  .Range("D2").Resize(i - 1, j - 1) = y
            End If
         
        End With
  Next
                 
End Sub

  ---

  Above is the script used.
  
  Also attached is the XLS database. At the current moment it lists only on issue raised against the job meanwhile i want it to list all issues that come into the criteria for that job into the users name.
  
  Please refer to sheet "LK" for how I'm hoping the end result should come in terms of format.
• "
• Note : for some reason - I can't seem to attach the file it just gives me a red "!"

Hi,

the file has been attached.

Sorry couldnt seem to attach it to the previous post.

thanks in advance

as the scripting dictionary was hiding any more than 1 fault per criteria match, i changed to insert rows and multiple faults per criteria

Code:

---

Sub matchData()

 Dim i&, j&, Diccol As Object, k As Long, x, a, n&, ws As Worksheet, TT, gd As Worksheet
Dim gr As Range
    Set gd = Worksheets("Google Data")
    With gd
        x = .Range("A1:X" & .Cells.Find("*", , , , xlByRows, xlPrevious).Row)
    End With
  For Each ws In ThisWorkbook.Worksheets
 
        With ws
       
            If Len(.Name) = 2 Or .Name = "SuDP" Then
           
                a = .Range("A2").CurrentRegion
               
                  If .Cells(.Rows.Count, 1).End(xlUp).Row - 1 = 0 Then Exit For
                  For i = 1 To UBound(a)
                    TT = a(i, 2)
                    Set fnd = gd.Range("j:j").Find(TT)
                    If Not fnd Is Nothing Then
                        strt = fnd.Row
                        If fnd.Offset(, 14) = .Range("c2") Then
                            Set gr = fnd.Offset(, -9).Resize(, 24)
                            Do
                                Set fnd = gd.Range("j:j").FindNext(fnd)
                                If fnd.Row = strt Then Exit Do
                                If fnd.Offset(, 14) = .Range("c2") Then Set gr = Union(gr, fnd.Offset(, -9).Resize(, 24))
                            Loop
                        End If
                    End If
                    If Not gr Is Nothing Then
                       
                        rw = .Range("b:b").Find(TT).Row
                        rws = gr.Cells.Count / gr.Columns.Count
                      If rws > 1 Then .Range(.Cells(rw + 1, 1), .Cells(rw + rws - 1, 1)).EntireRow.Insert
                      c = 0
                      For Each r In gr.Rows
                        .Cells(rw + c, 4).Resize(, 24).Value = r.Cells(1).Resize(, 24).Value
                        c = c + 1
                      Next
                    End If
                    Set gr = Nothing
                  Next
                 
            End If
         
        End With
  Next
                 
End Sub

---

this code is partially tested (works for first sheet 'dp'), but will still contain errors or incorrect results, but i am out of time now, so posting as a work in progress
your 'how it should be sheet', shows a count of faults per item, but you are already using that column in other sheets, but the rws variable give the count if you figure where you want to put it

formatting the sheets is fairly straight forward, though need to consider removing previous data formatting, maybe easier to delete all sheets and start from scratch
also once you have full name of users, you will be unable to use if len(ws.name) = 2

there is quite probably several better methods to achieve your result, including SQL, especially if the data can be considerably more than the 500 rows in the sample

Hi Westconn1,

I've tried the following and it seems to be working perfect for the User "DP".

The overall data will be higher than 500, I had to reduce the following so the file size wouldn't be too large.

The initial concept was to create script that would run creating a worksheet for the users as it is doing currently but the amount of users isn't a set value.

Then it would look through the "GOOGLE DATA" to populate information into the worksheets of the users based on the criteria.

and go to the next user and keep repeating the process until all the users have had the information copied over successfully.

Would it be possible to create a loop so that it would repeat the script for all the users/worksheets and format the users worksheets to something similar like "LK"

Thanks so much for the following seriously really appreciate your help

Quote:

---

Would it be possible to create a loop so that it would repeat the script for all the users/worksheets

---

the code posted should do that already. do a heap of testing to find out what problems may arise, check results are correct

Quote:

---

and format the users worksheets to something similar like "LK"

---

i will look into that later for you

i decided to do a sql version, posted below, but found an error in the code i posted previously
If fnd.Offset(, 14) = .Range("c2")
should be
If fnd.Offset(, 14) = a(i, 3)
change in 2 places

sql version, add a reference to ADO (microsoft activex data objects)

Code:

---

Sub matchData()

 Dim i&, j&, Diccol As Object, k As Long, x, a, n&, ws As Worksheet, TT, gd As Worksheet
Dim gr As Range, r As Range
Dim cn As Connection, rs As Recordset

    Set gd = Workbooks("database-1.xls").Worksheets("Google Data")
    Set cn = New ADODB.Connection
    With cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & gd.Parent.FullName & _
    "; Extended Properties=Excel 8.0;"
        .Open
    End With
    Set rs = New ADODB.Recordset
   
  For Each ws In Workbooks("database-1.xls").Worksheets
 
        With ws
       
            If Len(.Name) = 2 Or .Name = "SuDP" Then
                Debug.Print .Name
               
                a = .Range("A2").CurrentRegion
               
                  If .Cells(.Rows.Count, 1).End(xlUp).Row - 1 = 0 Then Exit For
                  For i = 1 To UBound(a)
                    Sql = "select * from [google data$] where [request id] = '" & a(i, 2) & "' and [estp/ttfn] = '" & a(i, 3) & "'"
                    rs.Open Sql, cn, adOpenStatic, adLockReadOnly
                    If rs.RecordCount > 0 Then
                        rw = .Range("b:b").Find(a(i, 2)).Row
                        If rs.RecordCount > 1 Then .Range(.Cells(rw + 1, 1), .Cells(rw + rws - 1, 1)).EntireRow.Insert

                        .Range("D" & rw).Resize(1, 24).CopyFromRecordset rs
                    end if
                    rs.Close
                Next
               
    'code to format cells           
                aheader = Array("Name", "Project ID", "Build Demarcation", "Defect number", "Title", "Defect Owner", "Assigned To", "Defect Status", "Defect Priority", "State", "FSA", "Estate Name", "Request ID", "Build Demarcation", "Description", "Due Date", "Closed Date", "Defect Comments", "Defect Type", "Defect Category", "Defect SubCategory", "Created By", "Created", "Designer", "Comments", "Date", "ESTP/TTFN")
                .Range(.Cells(1, 1), .Cells(1, 27)) = aheader
                .UsedRange.Columns.AutoFit = True
                .Range("o:o").WrapText = True
                .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 3)).Interior.ColorIndex = 45
                .Range(.Cells(1, 4), .Cells(1, 5)).Interior.ColorIndex = 35
            End If
        End With
  Next
                 
End Sub

---

you can test the 2 versions, i would be interested in speed comparisons,
i would believe that the sql version should be a lot quicker on larger google data,
again test thoroughly for errors and incorrect results
the format cells code can be copied into the earlier code as well at same location, test to see if is how you want

Hi Westconn1,


Thanks for the following :). Sorry for the late response as I didn't receive an email notification :(.


After copying the following code; I went into the reference options and selected "Microsoft ActiveX Data Objects 6.1 Library"


When selecting play the information that matches the criteria and copies the jobs from the "Report Manager" to the users worksheets (if the work sheet doesn't exist, it creates a worksheet for the user and adds the information. Which is great; the one issue I noticed is when the information is already existing within the worksheet if I select play, it copies the information into the worksheet again; would it be possible to create a rule that if the information already exists within the 'User Name' worksheet isn't copied.


Also just wanted to confirm

Code:

---

Set gd = Workbooks("database-1.xls").Worksheets("Google Data")

---

I should enter the file name in the brackets right?


Also when applying the information to the original document; the information coming up doesn't align:


Not all information is being copied correctly. I have added the proper user names into the attached for reference. I also needed help with the

Code:

---

If Len(.Name) = 2 Or .Name = "SuDP" Then

---

as this isn't usable any more as I've added full names now.


Also when running the script at the end I receive an error on

Code:

---

UsedRange.Columns.AutoFit = True

---

Error Details = Run time error '424' : object required

Initially around every month defects into the "Google Data" manually by pasting information in and same with the "Report Manager"

Thanks alot in advance.

Final File

Quote:

---

Error Details = Run time error '424' : object required

---

should be .usedrange

Quote:

---

Not all information is being copied correctly.

---

what is wrong? specific examples?

Quote:

---

when the information is already existing within the worksheet if I select play, it copies the information into the worksheet again;

---

as your original code was clearing all sheets first, i did not in any way take that into account, are you now updating from google data without clearing sheets?

Quote:

---

would it be possible to create a rule that if the information already exists within the 'User Name' worksheet isn't copied.

---

i am sure it is, but will have to think about it

Quote:

---

Set gd = Workbooks("database-1.xls").Worksheets("Google Data")

---

no longer required, only still used to pass the path of the workbook to the connection string for ADO
easy for me to use like that as the workbook was in some temporary folder, after downloading

Hi Westconn1,

Attached is the complete script I'm using at the moment :

I assume this is due to the

Code:

---

If Len(ws.Name) = 2 Or ws.Name = "SuDP" Then

---

which is used twice in the script, but as the latest attached excel document; I'm using full names now.

As an example: i think as .name is stated only for =2 and SUDP when i changed it to the peoples names i managed to get one to copy the information correctly.

What would the correct script be for the following; should i be writing all the users names with an OR ?

I'm still getting an run time error on

Code:

---

.UsedRange.Columns.AutoFit = True

---

Code:

---

Private Sub CommandButton1_Click()



 Dim a, i As Long, j As Long, NR As Long, LR&, ws As Worksheet, x
 
 Application.ScreenUpdating = 0
 
 For Each ws In ThisWorkbook.Worksheets
        If Len(ws.Name) = 2 Or ws.Name = "SuDP" Then
            ws.Cells.ClearContents
        End If
    Next
With Worksheets("Report Manager Data")
    a = .Range("X1:AE" & .Cells.Find("*", , , , xlByRows, xlPrevious).Row)
 End With


 For i = 2 To UBound(a)
 
    If a(i, 1) = "Event 6: QA Finished" Then
   
        If Not Evaluate("ISREF('" & a(i, 2) & "'!A1)") Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = a(i, 2)
        End If
       
        With Worksheets(a(i, 2))
            NR = .Cells(Rows.Count, "a").End(xlUp).Row + 1
              .Cells(NR, 1) = a(i, 2)
              .Cells(NR, 2) = a(i, 4)
              .Cells(NR, 3) = a(i, 8)
        End With
    End If
 Next
 Call matchData
  Application.ScreenUpdating = True
End Sub
Sub matchData()
   
    Dim i&, j&, Diccol As Object, k As Long, x, a, n&, ws As Worksheet, TT, gd As Worksheet
    Dim gr As Range, r As Range
    Dim cn As Connection, rs As Recordset
   
    Set gd = Workbooks("v.20 (1) (5) (2).xlsm").Worksheets("Google Data")
    Set cn = New ADODB.Connection
    With cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & gd.Parent.FullName & _
        "; Extended Properties=Excel 8.0;"
        .Open
    End With
    Set rs = New ADODB.Recordset
   
    For Each ws In Workbooks("v.20 (1) (5) (2).xlsm").Worksheets
       
        With ws
           
            If Len(.Name) = 10 Or .Name = "Udeshika Dissanayake" Then
                Debug.Print .Name
               
                a = .Range("A2").CurrentRegion
               
                If .Cells(.Rows.Count, 1).End(xlUp).Row - 1 = 0 Then Exit For
                For i = 1 To UBound(a)
                    Sql = "select * from [google data$] where [request id] = '" & a(i, 2) & "' and [estp/ttfn] = '" & a(i, 3) & "'"
                    rs.Open Sql, cn, adOpenStatic, adLockReadOnly
                    If rs.RecordCount > 0 Then
                        rw = .Range("b:b").Find(a(i, 2)).Row
                        If rs.RecordCount > 1 Then .Range(.Cells(rw + 1, 1), .Cells(rw + rws - 1, 1)).EntireRow.Insert
                       
                        .Range("D" & rw).Resize(1, 24).CopyFromRecordset rs
                    End If
                    rs.Close
                Next
               
                'code to format cells
                aheader = Array("Name", "Project ID", "Build Demarcation", "Defect number", "Title", "Defect Owner", "Assigned To", "Defect Status", "Defect Priority", "State", "FSA", "Estate Name", "Request ID", "Build Demarcation", "Description", "Due Date", "Closed Date", "Defect Comments", "Defect Type", "Defect Category", "Defect SubCategory", "Created By", "Created", "Designer", "Comments", "Date", "ESTP/TTFN")
                .Range(.Cells(1, 1), .Cells(1, 27)) = aheader
                .UsedRange.Columns.AutoFit = True
                .Range("o:o").WrapText = True
                .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 3)).Interior.ColorIndex = 45
                .Range(.Cells(1, 4), .Cells(1, 5)).Interior.ColorIndex = 35
            End If
        End With
    Next
   
End Sub

---

Quote:

---

What would the correct script be for the following; should i be writing all the users names with an OR ?

---

easier to just list the sheets not to use, which should remain constant and allow names sheets to be dynamic

Code:

---

for each ws in thisworkbook.worksheets
  select case ws.name
    case "Summary","Google Data","Report Manager Data","Merged List","How it should be" ' add others if required
            ' do nothing
    case else
            ' code here
  end select
next

---

Quote:

---

I'm still getting an run time error on

---

hmmmm autofit is a method, not a property, remove = true

Hi Westconn1,

Thanks alot for the following :) sorry for troubling you so much.

At the top section of the script I have replaced the lines with the VB code you've mentioned above unsure if i did this correctly. But in terms of adding it to the below section would it be possible to get your guidance ?

Also would It be possible to prevent copying of information if the data already exists?

sorry for the trouble.

Code:

---

Private Sub CommandButton1_Click()



 Dim a, i As Long, j As Long, NR As Long, LR&, ws As Worksheet, x
 
 Application.ScreenUpdating = 0
 
 For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
    Case "Summary", "Google Data", "Report Manager Data", "Merged List", "How it should be" ' add others if required
        ' do nothing
    Case Else
        ' code here

With Worksheets("Report Manager Data")
    a = .Range("X1:AE" & .Cells.Find("*", , , , xlByRows, xlPrevious).Row)
 End With
    End Select
Next

 For i = 2 To UBound(a)
 
    If a(i, 1) = "Event 6: QA Finished" Then
   
        If Not Evaluate("ISREF('" & a(i, 2) & "'!A1)") Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = a(i, 2)
        End If
       
        With Worksheets(a(i, 2))
            NR = .Cells(Rows.Count, "a").End(xlUp).Row + 1
              .Cells(NR, 1) = a(i, 2)
              .Cells(NR, 2) = a(i, 4)
              .Cells(NR, 3) = a(i, 8)
        End With
    End If
 Next
 Call matchData
  Application.ScreenUpdating = True
End Sub
Sub matchData()
   
    Dim i&, j&, Diccol As Object, k As Long, x, a, n&, ws As Worksheet, TT, gd As Worksheet
    Dim gr As Range, r As Range
    Dim cn As Connection, rs As Recordset
   
    Set gd = Workbooks("v.20 (1) (5) (2).xlsm").Worksheets("Google Data")
    Set cn = New ADODB.Connection
    With cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & gd.Parent.FullName & _
        "; Extended Properties=Excel 8.0;"
        .Open
    End With
    Set rs = New ADODB.Recordset
   

       

Code:

       

---

  For Each ws In Workbooks("v.20 (1) (5) (2).xlsm").Worksheets
        
        With ws
            
            If Len(.Name) = 10 Or .Name = "Udeshika Dissanayake" Then
                Debug.Print .Name

---

                a = .Range("A2").CurrentRegion
               
                If .Cells(.Rows.Count, 1).End(xlUp).Row - 1 = 0 Then Exit For
                For i = 1 To UBound(a)
                    Sql = "select * from [google data$] where [request id] = '" & a(i, 2) & "' and [estp/ttfn] = '" & a(i, 3) & "'"
                    rs.Open Sql, cn, adOpenStatic, adLockReadOnly
                    If rs.RecordCount > 0 Then
                        rw = .Range("b:b").Find(a(i, 2)).Row
                        If rs.RecordCount > 1 Then .Range(.Cells(rw + 1, 1), .Cells(rw + rws - 1, 1)).EntireRow.Insert
                       
                        .Range("D" & rw).Resize(1, 24).CopyFromRecordset rs
                    End If
                    rs.Close
                Next
               
                'code to format cells
                aheader = Array("Name", "Project ID", "Build Demarcation", "Defect number", "Title", "Defect Owner", "Assigned To", "Defect Status", "Defect Priority", "State", "FSA", "Estate Name", "Request ID", "Build Demarcation", "Description", "Due Date", "Closed Date", "Defect Comments", "Defect Type", "Defect Category", "Defect SubCategory", "Created By", "Created", "Designer", "Comments", "Date", "ESTP/TTFN")
                .Range(.Cells(1, 1), .Cells(1, 27)) = aheader
                .UsedRange.Columns.AutoFit
                .Range("o:o").WrapText = True
                .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 3)).Interior.ColorIndex = 45
                .Range(.Cells(1, 4), .Cells(1, 5)).Interior.ColorIndex = 35
            End If
        End With
    Next
   
End Sub

---

it is not really correct

Quote:

---

For Each ws In ThisWorkbook.Worksheets
If Len(ws.Name) = 2 Or ws.Name = "SuDP" Then
ws.Cells.ClearContents
End If
Next

---

change to

Code:

---

  For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
        Case "Summary", "Google Data", "Report Manager Data", "Merged List", "How it should be" ' add others if required
            ' do nothing
        Case Else
            ws.cells.clearcontents
        End Select
    Next

---

the select case should be a direct replace for the if to end if in each case
though in this case i believe it would probably be better to delete all those worksheets, then add them again later

Quote:

---

Also would It be possible to prevent copying of information if the data already exists?

---

as the match data is called from button click, where all sheets are blanked first, how can the same information exist, unless i is in the google data multiple times?
what constitutes a copy? how many matching cells? i will have to look at how to prevent copying duplicates

i still had this, so i copy for you

Code:

---

Sub matchData()
   
    Dim i&, j&, Diccol As Object, k As Long, x, a, n&, ws As Worksheet, TT, gd As Worksheet
    Dim gr As Range, r As Range
    Dim cn As Connection, rs As Recordset
   
    Set gd = ThisWorkbook.Worksheets("Google Data")
    Set cn = New ADODB.Connection
    With cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & gd.Parent.FullName & _
        "; Extended Properties=Excel 8.0;"
        .Open
    End With
    Set rs = New ADODB.Recordset
   
    For Each ws In ThisWorkbook.Worksheets
       
        With ws
            Select Case ws.Name
            Case "Summary", "Google Data", "Report Manager Data", "Merged List", "How it should be" ' add others if required
                    ' do nothing
            Case Else
                    ' code here
           
                Debug.Print .Name
               
                a = .Range("A2").CurrentRegion
               
                If .Cells(.Rows.Count, 1).End(xlUp).Row - 1 = 0 Then Exit For
                For i = 1 To UBound(a)
                    Sql = "select * from [google data$] where [request id] = '" & a(i, 2) & "' and [ESTP/TTFN] = '" & a(i, 3) & "'"
                    rs.Open Sql, cn, adOpenStatic, adLockReadOnly
                    If rs.RecordCount > 0 Then
                        rw = .Range("b:b").Find(a(i, 2)).Row
                        If rs.RecordCount > 1 Then .Range(.Cells(rw + 1, 1), .Cells(rw + rws - 1, 1)).EntireRow.Insert
                       
                        .Range("D" & rw).Resize(1, 24).CopyFromRecordset rs
                    End If
                    rs.Close
                Next
               
                'code to format cells
                aheader = Array("Name", "Project ID", "Build Demarcation", "Defect number", "Title", "Defect Owner", "Assigned To", "Defect Status", "Defect Priority", "State", "FSA", "Estate Name", "Request ID", "Build Demarcation", "Description", "Due Date", "Closed Date", "Defect Comments", "Defect Type", "Defect Category", "Defect SubCategory", "Created By", "Created", "Designer", "Comments", "Date", "ESTP/TTFN")
                .Range(.Cells(1, 1), .Cells(1, 27)) = aheader
                .UsedRange.Columns.AutoFit
                .Range("o:o").WrapText = True
                .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 3)).Interior.ColorIndex = 45
                .Range(.Cells(1, 4), .Cells(1, 5)).Interior.ColorIndex = 35
            End Select
        End With
    Next
   
End Sub

---

Hi Westconn1,

Thanks for the following :) I've added the total data and in terms of copying the data; it works perfectly.

• The excel sheet now has no issues in terms of copying duplicates.

1. I had a request : When copying the details from Report Manager/Google Data - there are blanks present which are creating issues when I'm trying to create a Pivot table.

Would it be possible to start copying the information on the next line instead of leaving a blank.

As for an example i have attached a screenshot for reference.

Referring to the red for blanks. Initally there are blanks for all the users.

Attachment 11281

i have no idea why there should be blank lines, if there is no google data then some lines would have blank data, but i can not see why line 9 should be blanks

do the blanks exist before calling matchdata?

Hi Westconn1,

1) When I ran the script manually before matchdata it didn't seem to have any issues; so I'm guessing the issue occurs after matchdata is called. I've played around trying to figure why this issue seems to occur but I can't come to a conclusion as it impacts both sides. Also there are no blanks within the Google Data

2) Would it be possible to get your opinion on how I link all this information into a dashboard? I'm thinking something like "IF Ex contains a value, ACx = Worksheet name" within the "USER name worksheets" AND Maybe add use column D to show the Actioned on Date from Report Manager (just the date 01/01/2013 time not required)

Would that work?

So I can link the issues in a chart base? do you think this seems reasonable or would there be a quicker way around this ?

Thanks In Advance.

Quote:

---

So I can link the issues in a chart base?

---

i have no idea what you mean by this

i think i found the issue with blank lines, change this line

Code:

---

If rs.RecordCount > 1 Then .Range(.Cells(rw + 1, 1), .Cells(rw + rs.RecordCount - 1, 1)).EntireRow.Insert

---

Hi Westconn1,

thanks alot for the following; just doing the final testing; to see if there are any issues remaining.

Will update you.

Thanks again