VBA help

CY078

New Member
Joined
Nov 2, 2014
Messages
31
Office Version
  1. 365
Platform
  1. Windows
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"
1633676354025.png

- 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

Well-known Member
Joined
Feb 23, 2021
Messages
2,012
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

CY078

New Member
Joined
Nov 2, 2014
Messages
31
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Feb 23, 2021
Messages
2,012
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Nov 2, 2014
Messages
31
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Feb 23, 2021
Messages
2,012
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Ok, will modify it tomorrow.
 

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
2,012
Office Version
  1. 365
Platform
  1. Windows
OK try this.
You will need to maintain this line if and when required.
VBA Code:
   ExcludeShtLst = "Master, Summary, Formula, Creative Concept"

VBA Code:
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
 
Solution

CY078

New Member
Joined
Nov 2, 2014
Messages
31
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Feb 23, 2021
Messages
2,012
Office Version
  1. 365
Platform
  1. Windows
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.
 

Forum statistics

Threads
1,143,687
Messages
5,720,296
Members
422,275
Latest member
Maria95

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
Top