VBA help

[CY078]

Hi All

Background
- I'm having very inconsistent results with my Macro.
- Fundamentally it is meant to grab all the data from all tabs and then combine it into one.
- It sometimes works and sometimes does not.

Macro

Sub Merge_Sheets()

Dim startRow, startCol, lastRow, lastCol As Long
Dim headers As Range

'Set Master sheet for consolidation
Set mtr = Worksheets("Master")

Set wb = ThisWorkbook
'Get Headers
Set headers = Application.InputBox("Select the Headers", Type:=8)

'Copy Headers into master
headers.Copy mtr.Range("A1")
startRow = headers.Row + 1
startCol = headers.Column

Debug.Print startRow, startCol
'loop through all sheets
For Each ws In wb.Worksheets
'except the master sheet from looping
If ws.Name <> "Master" Then
ws.Activate
lastRow = Cells(Rows.Count, startCol).End(xlUp).Row
lastCol = Cells(startRow, Columns.Count).End(xlToLeft).Column
'get data from each worksheet and copy it into Master sheet
Range(Cells(startRow, startCol), Cells(lastRow, lastCol)).Copy _
mtr.Range("A" & mtr.Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
Next ws

Worksheets("Master").Activate

End Sub

Process
- Run Macro
- It will ask me to "Select the Headers"

- I proceed to select the headers. They are all in the same place on all the tabs.
Note1: If I put just row 37 ... it does not work at all (Thus I have to put the block of data)
Note2: Putting the tab name in front of the cell selection does not make a difference
Note3: There are some tabs that I don't require the data from but I assume it will just grab the data at that point and I sort out what I require ... (thus the assumption there is no impact on the end result)

Outcome
- All data is extracted and put into a tab named "master"
- When it works, I just sort by the "yearly total" column, and delete the other data I do not require
- Sometimes it just gets the data from one of the tabs
- Sometimes its a mixture of data from many tabs

Question
- Have I written the macro incorrectly ?
- Is it something to do with the headers ?
- Is it something to do with something else ?

Notes
- I'm using MS365 64bit
- I can't download a "XL2BB" cause this is a company lappy. I require admin access to put it on.

Can anyone shed some light on my situation please.

Thank you in advance

 

[Alex Blakenburg]

We need some way of deciding which sheets.
Do the missed tabs have 5 numbers on the end of the sheet name ?
Check that there isn't a space at the end of the sheet name.

 

[CY078]

So one of the workbooks, all tabs have numbers at the end. Another that had the missing data .. was the data from the tab without numbers. And one had no numbers at all but the macro managed to grab data from one of the tabs.

Instead of deciding which sheets ... wouldn't it be better to exclude Master / Summary / Formula ? Wouldn't this just grab any other sheet no matter what the naming convention is ??

 

[Alex Blakenburg]

I can easily change it. The reason I went the other way, is that the code originally only excluded “Master” but then you gave me a workbook with more sheets that clearly needed to be excluded.
You are saying to exclude Master / Summary / Formula, but what about the reversal sheet and the conceptual sheet.

 

[CY078]

You are saying to exclude Master / Summary / Formula, but what about the reversal sheet and the conceptual sheet.

Include them. If I need to omit the data for whatever reason then I can easily delete from the master sheet.

But the master / summary / formula I definitely don’t require

 

[Alex Blakenburg]

Ok, will modify it tomorrow.

 

[Alex Blakenburg]

OK try this.
You will need to maintain this line if and when required.

   ExcludeShtLst = "Master, Summary, Formula, Creative Concept"

Sub Merge_SheetsNew()

    Dim hdgRow As Long, startRow  As Long, lastRow   As Long, lastCol As Long
    Dim headers As Range
    Dim mtr As Worksheet
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim HdrKeyCell As Range
    Dim KeyCol As Long
    Dim mtrlastRow As Long
    Dim FindInHdr As String
    Dim headerRow As Long
    Dim ExcludeShtLst As String
    
    Application.ScreenUpdating = False
    
    'Set Master sheet for consolidation
    Set mtr = Worksheets("Master")
    Set ws = ActiveSheet
    
    ' This is currently the case but may change since it is being installed on multiple workbooks
    Set wb = ThisWorkbook
    FindInHdr = "Internal Order"
    ExcludeShtLst = "Master, Summary, Formula, Creative Concept"
    
    ' Find first Data Sheet
    For Each ws In wb.Worksheets
        If InStr(1, ExcludeShtLst, ws.Name, vbTextCompare) = 0 Then
                
            Set HdrKeyCell = ws.Cells.Find(What:=FindInHdr, After:=ws.Range("A1"), LookIn:=xlFormulas, LookAt _
                :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                True)

            If HdrKeyCell Is Nothing Then
                MsgBox "Header row not found in sheet " & ws.Name & " using " & FindInHdr & vbLf _
                & "Exiting Procedure"
                GoTo ExitSub
            End If
            Exit For
        End If
    
    Next ws
    
    hdgRow = HdrKeyCell.Row
    KeyCol = HdrKeyCell.Column
    lastCol = ws.Cells(hdgRow, Columns.Count).End(xlToLeft).Column
    
    'Copy Headers into master
    Set headers = ws.Range(ws.Cells(hdgRow, "B"), ws.Cells(hdgRow, lastCol))
    headers.Copy mtr.Range("A1")
    
    For Each ws In wb.Worksheets
        'Was only excluding master now pick up data sheets based on trailing numeric value
        If InStr(1, ExcludeShtLst, ws.Name, vbTextCompare) = 0 Then
            With ws

                startRow = hdgRow + 1
                lastRow = ws.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
                mtrlastRow = mtr.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row + 1
                
                If lastRow > startRow Then
                    'get data from each worksheet and copy it into Master sheet
                    .Range(.Cells(startRow, "B"), .Cells(lastRow, lastCol)).Copy
                    mtr.Range("A" & mtrlastRow).PasteSpecial xlPasteValues
                    mtr.Range("A" & mtrlastRow).PasteSpecial xlPasteFormats
                End If
            End With

        End If
    Next ws
    
    mtr.Range(Cells(1, "A"), mtr.Cells(1, Columns.Count).End(xlToLeft)).EntireColumn.AutoFit
    mtr.Activate
    mtr.Range("A2").Select
          
ExitSub:
    Application.ScreenUpdating = True

End Sub

 

[CY078]

Sorry for the delay in response ... I was pulled to another project to "put a fire out" :P

Yes I can confirm it now works. Its obvious my macro writing skills are pretty much non existent ... but what you have shown me has helped immensely ... so thanks heaps for your efforts ... its been very educational and most of all you have helped me heaps.

Thanks

 

[Alex Blakenburg]

I appreciate your feedback. It is always nice to hear that you have helped someone improve their skills and not just provided an immediate solution.
Glad I was able to help.