Hi nilem, works great! Thank you!!
Here's the final code (w/minor aesthetic additions):
Option Explicit
Sub Update_Master()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("Master!A:A").ClearContents
With Range("Master!A1")
.Formula = "MDET"
.Font.Bold = True
End With
Dim x, rez(), wsh As Worksheet, i As Long, k As Long
Dim mdet As Range
ReDim rez(1 To 100000, 1 To 1)
On Error Resume Next
With New Collection
For Each wsh In ThisWorkbook.Worksheets
If Not wsh Is ActiveSheet Then
Set mdet = wsh.Rows(1).Find("MDET", LookAt:=xlWhole)
If Not mdet Is Nothing Then
x = wsh.Range(mdet.Offset(1), wsh.Cells(Rows.Count, mdet.Column).End(xlUp)).Value
For i = 1 To UBound(x)
If IsEmpty(.Item(x(i, 1))) Then k = k + 1: rez(k, 1) = x(i, 1): .Add k, x(i, 1)
Next i: End If: End If: Next wsh: End With
If k = 0 Then Exit Sub
With [a2].Resize(k)
.Value = rez()
.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Order3:=xlAscending, Header:=xlNo, MatchCase:=False
End With
'Additional code
Cells.EntireColumn.AutoFit
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks