This will run (i.e. update the 'wstConsole' tab) only for the sheets in 'varMyArray':
Note the code goes into a standard module (the same as when you record a macro).Code:Option Explicit Sub Macro1() Const lngStartRow As Long = 3 'Commencement row number for data. Change to suit. Dim lngEndRow As Long Dim rngCell As Range Dim lngMyRow As Long Dim wstConsole As Worksheet Dim varMySheet As Variant, _ varMyArray As Variant Application.ScreenUpdating = False varMyArray = Array("CONTRACTS", "USED CONTRACTS") 'These are the tabs to be processed to the 'wstConsole' tab. Change to suit. Set wstConsole = Worksheets("MASTER SHEET") 'Tab name for the data to be updated into. Change to suit. For Each varMySheet In varMyArray lngEndRow = Sheets(CStr(varMySheet)).Range("A:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Find the last row in ws1 from columns A to M (inclusive) For Each rngCell In Sheets(CStr(varMySheet)).Range("B" & lngStartRow & ":B" & lngEndRow) 'If there's a reg number in column B of the current row, then... If Len(rngCell) > 0 Then On Error Resume Next '...try and find if it's already exists in the 'wstConsole' sheet lngMyRow = 0 'Initialise variable 'Note if the reg number becomes numeric, you'll need to remove the double quotation marks around rngCell If InStr(CStr(wstConsole.Name), " ") > 0 Then lngMyRow = Evaluate("MATCH(""" & rngCell & """ ,'" & CStr(wstConsole.Name) & "'!B:B,0)") 'Put single quotation marks around 'wstConsole' tab if there's a space (or spaces) in its name Else lngMyRow = Evaluate("MATCH(""" & rngCell & """ ," & CStr(wstConsole.Name) & "!B:B,0)") End If On Error GoTo 0 'If the reg number is already in 'wstConsole' then... If lngMyRow <> 0 Then '...link the data from SHEET1 to the applicable row in wstConsole wstConsole.Range("A" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("A" & rngCell.Row).Value wstConsole.Range("B" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("B" & rngCell.Row).Value wstConsole.Range("K" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("C" & rngCell.Row).Value wstConsole.Range("L" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("D" & rngCell.Row).Value wstConsole.Range("M" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("E" & rngCell.Row).Value wstConsole.Range("E" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("F" & rngCell.Row).Value wstConsole.Range("H" & lngMyRow).Formula = "=D" & lngMyRow & "-E" & lngMyRow 'Else... Else '...find the next available row in 'wstConsole' and then link the data from the 'varMySheet' to that row. lngMyRow = wstConsole.Range("A:H").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 'Find the last row in ws2 from columns A to H (inclusive) and increment this by 1 wstConsole.Range("A" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("A" & rngCell.Row).Value wstConsole.Range("B" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("B" & rngCell.Row).Value wstConsole.Range("K" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("C" & rngCell.Row).Value wstConsole.Range("L" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("D" & rngCell.Row).Value wstConsole.Range("M" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("E" & rngCell.Row).Value wstConsole.Range("E" & lngMyRow).Value = Sheets(CStr(varMySheet)).Range("F" & rngCell.Row).Value wstConsole.Range("H" & lngMyRow).Formula = "=D" & lngMyRow & "-E" & lngMyRow End If End If Next rngCell Next varMySheet Application.ScreenUpdating = True End Sub
Robert




Reply With Quote
Bookmarks