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