Merge data into a table, filter and remove any blanks then remove the table range and re run without deleting the tab and recreating it

StillUnderstanding

Board Regular
Joined
Jan 30, 2021
Messages
80
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

It would be great if someone amazing might be able to help me to work this out!

So I have a spreadsheet that we use in Teams and I am trying to merge a load of data from about 30 tabs into a "Consolidate Data" tab, the problem I am having is that the action of deleting the tab and recreating it is resulting in the other user of the sheet having to reopen it.

It looks like Teams cant handle having 5 users in the workbook at the same time with one user deleting and creating tabs.

Here is the code that I am using:
VBA Code:
Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet()
'Procedure to Consolidate all sheets in a workbook

On Error GoTo IfError

'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'3. Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete

Application.DisplayAlerts = True


 

'4. Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
  If Sht.Name <> "IT Equipment Tracker" And Sht.Name <> DstSht.Name And Sht.Name <> "Master" Then
       '5.1: Find the last row on the 'Consolidate_Data' sheet
       DstRow = fn_LastRow(DstSht)
      
    
 
              
       '5.2: Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A7:" & EnRange)
      
       '5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
        If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
            MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
            GoTo IfError
        End If
                
      '5.4: Copy data to the 'consolidated_data' WorkSheet
        SrcRng.Copy Destination:=DstSht.Range("A" & DstRow + 1)
                
    End If

Next
 Sheets("Template to copy").Select
    Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Sheets:=38
    Sheets("Consolidate_Data").Select
    Range("A1").Select
    ActiveSheet.Paste

IfError:

'6. Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
     Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$BD$2500"), , xlYes).Name _
        = "Table8"
    Range("Table8[#All]").Select
 
    ActiveWindow.Zoom = 70
    ActiveSheet.ListObjects("Table8").Range.AutoFilter Field:=1, Criteria1:="="
    Rows("20:20").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ListObjects("Table8").Range.AutoFilter Field:=1

End Sub
'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(Sht As Worksheet)

    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function

'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(Sht As Worksheet)

    Dim lastCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Lcol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(Lcol)) = 0 And Lcol <> 1
        Lcol = Lcol - 1
    Loop
    fn_LastColumn = Lcol

End Function


I guess what I am wanting to do it to be able to clear the Consolidate Data tab rather than delete and recreate, I am just not too sure how to do it.

Any and all help is appreciated!

Thanks
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Forum statistics

Threads
1,223,908
Messages
6,175,307
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top