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

[Padwan]

Hi Guys,

I'd really appreciate your help.

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,

[Padwan]

Hi Guys,

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

thanks

[Padwan]

Hi Guys,

Would anyone be able to help me with the above ?

[westconn1]

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

[Padwan]

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)



'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


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

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 "!"

[Padwan]

Hi,

the file has been attached.

Sorry couldnt seem to attach it to the previous post.

thanks in advance

[westconn1]

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


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

[Padwan]

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

[westconn1]

Would it be possible to create a loop so that it would repeat the script for all the users/worksheetsthe code posted should do that already. do a heap of testing to find out what problems may arise, check results are correct


and format the users worksheets to something similar like "LK"i will look into that later for you

[westconn1]

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)


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

[Padwan]

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

[Padwan]

Final File

[westconn1]

Error Details = Run time error '424' : object requiredshould be .usedrange


Not all information is being copied correctly.what is wrong? specific examples?


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?

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


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

[Padwan]

Hi Westconn1,

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

I assume this is due to the
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
.UsedRange.Columns.AutoFit = True


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

[westconn1]

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

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


I'm still getting an run time error onhmmmm autofit is a method, not a property, remove = true

[Padwan]

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.


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


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

[westconn1]

it is not really correct

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

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


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

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

[Padwan]

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.




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.

11281

[westconn1]

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?

[Padwan]

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.

[westconn1]

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

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

[Padwan]

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