We help IT Professionals succeed at work.
Private

Consolidate all data from various sheets into 1 sheet (with customised prompt)

104 Views
Last Modified: 2020-08-16
macro to consolidate all sheets data into 1 sheet

to prompt: start and end column
acceptable answer - for eg, A-M

Action= populate all the rest of the unhidden sheets (all data inside)into the active sheet
Comment
Watch Question

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Please provide a small sample workbook that includes a sheet that shows the expected results.
Professor JMicrosoft Excel Expert
CERTIFIED EXPERT
Top Expert 2014

Commented:
You can convert them all as table and then use power query to merge them all using power query wizard.

Author

Commented:
@ProfessorJ
yes power query, but macro would be more flexible and faster than power query when i have many other workbooks to follow all these steps which i also tried.

Author

Commented:
@Martin Liss 

Desired Result: Combine Sheet1 to Sheet4 and put them in to "Consol"

[embed=file 1470332]

Thus the macro should prompt:

to prompt: start and end column
Answer: A-M
Results= Consol to have all the data from Sheet1 to Sheet4 from Column A to M to be in.  

NOTE:
This macro can also be used for other workbooks
to prompt: start and end column
Answer: A-Z
Results= Consol to have all the data from Sheet1 to Sheet4 from Column A to Z to be in.  
The sheet names can be different names, as long as they are NOT hidden, they are all consolidated into a worksheet named "Consol"
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I don't know what happened but when I look at your post I see this:

2020-06-26_13-49-11.png
It would still help me understand what you need if you could supply a small sample workbook.

Author

Commented:
@Martin Liss

Think i have used "text"button , upload and the embed file
anyhow now i used upload file icon
Combine Sheets.xlsx
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Do you want the Consol sheet to be cleared first? Or do you want the data appended to the Consol sheet?

Could the Answer be A, D, L-M?

Could the Answrr be a single column like just F?
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Press Shift+Ctrl+C in the attached workbook. Depending on the answers to my questions I'll at last add code that validation the Answer.
29186244.xlsm

Author

Commented:
Do you want the Consol sheet to be cleared first? Or do you want the data appended to the Consol sheet?
= data to be appended to Consol Sheet

Could the Answer be A, D, L-M?
=Yes, answer could be single column such as A or from any column to any column for example, F-M or M-AD.

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
About appending, are you saying that if yesterday you had selected columns B to G and there were, say a total of 2000 rows, that if you were to select Q to Z today then the existing 2000 rows would not be cleared and the Q to Z data would start at row 2001?

To specify the columns you want, I think the best way would be for you to physically select the columns. In other words if you wanted to use columns B to D and G to H you would do this.
2020-06-27_21-14-21.png

Author

Commented:
this macro is to be used in various workbook.
if it is in workbook 1, then the append would be column A-M from the rest of the worksheets into Consol. A-M will always be used. 
if it is in workbook 2, then i will choose B-F. and B-F will always be used.
if it is in workbook 3, then i will choose A-G and A-G will always be used.

The prompt just adds flexibility for me to use in different workbooks.
Of course i can copy and paste but there are many worksheets.

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Of course i can copy and paste but there are many worksheets
I'm not suggesting that you copy/paste but rather that you just select the columns on just one of the sheets so that the code can know which columns you want to append.

If you can tell me the actual names of the workbooks and the columns that you want to append in each of the workbooks it will be easier.
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Again press Shift+Ctrl+C in the attached workbook and let me know if it does what you want it to do.
29186244a.xlsm

Author

Commented:
What i did - Steps:
1. by creating a "Consol" worksheet  (previous "Consol" was renamed to "Consol1)
2. copied the macro into my personal macro
3. Alt + F8
4. type column "A-B"
5.Ok

Run-time error '9':
Subscript out of range

Error at this line:
"Set wsConsol = ThisWorkbook.Worksheets("Consol")"   

But if i do the following :
  1. test by creating a "Consol" worksheet  (previous "Consol" was renamed to "Consol1)
  2. Alt + F8 (ie. i just use the macro directly from the workbook
  3. type column "A-B"
  4. Ok
Then it works.

Question:
1. Why did the above happens?
2. Does it mean when i type in the column A-B, it will automatically choose the first sheet, ie sheet1?



If you can tell me the actual names of the workbooks and the columns that you want to append in each of the workbooks it will be easier.
= no, I would not know the actual names of workbooks, they can vary. The columns will be the ones i type. for eg. A-B, A-Z.
I think it is the name of the sheet that is important.
Meaning, after prompting columns, then next is name of the sheet that the columns are from.

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
You show this line.

"Set wsConsol = ThisWorkbook.Worksheets("Consol")"  
Did you actually add the beginning and ending quotes to the line in the code or did you just do that when you pasted the line here? They should not be in the code.

The subscript out of range error means that you did not have a sheet named Consul. If you had Consul with one or more following spaces you would get that error since the name needs to be exactly Consul.

Alt + F8 (ie. i just use the macro directly from the workbook
What do you mean by that?

2. Does it mean when i type in the column A-B, it will automatically choose the first sheet, ie sheet1?
When you type in A-B it means that those two columns will be copied from every visible sheet to the Consul sheet.

By the way if you wanted to copy columns A ,C, E, F and G you would type in A,C,E-G

I think it is the name of the sheet that is important.
Meaning, after prompting columns, then next is name of the sheet that the columns are from.
I'm sorry but I don't know what that means.

Author

Commented:
If i copy the code and paste it in my Personal Macro module, then i will have the error - the line is highlighted at this code:
If i copy the code and paste it within the excel workbook module, then i will have the error - the line is highlighted at this code:


ALT+F8 = just to evoke the macro dialog box so that i can select and run the specific macro that i want to run

I think it is the name of the sheet that is important. Meaning, after prompting columns, then next is name of the sheet that the columns are from. = never mind.Ignore this comment, I will just hide those sheets that i don't need so the macro just copy those that are active.

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Try changing

Set wsConsol = ThisWorkbook.Worksheets("Consol")

Open in new window


to

Set wsConsol = Acriveworkbook.Worksheets("Consol")

Open in new window


and if that doesn't work then

Set wsConsol = Worksheets("Consol")

Open in new window


Try doing the same thing for
For Each ws in ThisWorkbook.Worksheets

Open in new window

In other words try changing ThisWorkbook to AcativeWorkbook, or just leaving out AcativeWorkbook (plus the period) if that doesn't work.

Author

Commented:
i have changed to :

Set wsConsol = ActiveWorkbook.Worksheets("Consol")
and
For Each ws In ActiveWorkbook.Worksheets

but there is still the same error as described above when i run the macro from my Personal Macro.
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I'm sorry but if you tried all my suggestions then I'm out of ideas.
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Actually, let me give this one more shot.

When you open any workbook and go to Visual Basic, do you see something like this?. I took this picture after opening the workbook called TestP.xlsm. There's nothing special about that workbook and any workbook would do. Note that Personal.XLSB shows up.

Does that happen when you open a workbook?

In the TestP workbook when I go to the Developer Tab and click 'Macros' in the 'Code' pane I see this where it shows me the two macros that I added to my Personal.xlsb workbook.

When I select and run the 'TestPersonal' macro which looks like this, it runs perfectly. Note that TestP has a worksheet called 'Consul'.
Sub TestPersonal()
Dim ws As Worksheet

Set ws = Sheets("Consul")

ws.Activate
ws.Range("B5").Select
End Sub

Open in new window


If any of the above doesn't work for you in your workbooks then maybe you didn't properly create your Personal.xlsb file. To create mine I opened a new workbook and clicked the Record Macro icon and chose 'Personal Macro Workbook' in the 'Store Macro In' dropdown. Then I  I just did something trivial like selecting some cells. When I stopped the recording the Personal.xlsb file was created. I then copy/pasted the two macros to the Personal workbook, deleted the trivial macro and closed Excel.

Author

Commented:
When I was running the code from Personal.xlsb, it was opened as I purposely unhide the file and go to the visual basic to run the code.



Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I don't know what you are trying to tell me.

Author

Commented:
I copied and pasted the macro into a module in a new workbook.
29186244-B_CONSOL Example.xlsm

and the following error occured when i run the macro: (i state A-E in the dialog box to indicate i want to copy column A to column E from both sheet 1 to sheet 2 into Consol)



I mean, shouldn't the code run wherever it is placed ?
In this case, i didn't even activate my Personal Macro but paste the macro inside this workbook.
but the error occured and thus nothing was pasted in the Consol worksheet.

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
It looks like you didn't copy the isInAlphaOrder function correctly In the workbook you posted because it looks like this.
Private Function isInAlphaOrder(strAnswer As String) As Boolean
Dim strParts() As String
Dim intPart As Integer

isInAlphaOrder = True

Open in new window


Th bottom is cut off; It should look like this.

Private Function isInAlphaOrder(strAnswer As String) As Boolean
Dim strParts() As String
Dim intPart As Integer

isInAlphaOrder = True

strParts = Split(strAnswer, ",")

For intPart = 0 To UBound(strParts)
    If InStr(strParts(intPart), ":") > 0 Then
        If Split(strParts(intPart), ":")(0) > Split(strParts(intPart), ":")(1) Then
            isInAlphaOrder = False
            MsgBox "Answer contains range '" & Replace(strParts(intPart), ":", "-") & "' which is out of order"
            Exit Function
        End If
    End If
Next
End Function

Open in new window

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Have you gotten the answer that you needed, or do you need more help?  If you have what you need then please close this question.  If you are unsure how to do that then please take a look at:
How do I select a solution for my question?

Author

Commented:
@Martin Liss,

This is now the full code that i use in the new workbook :

Option Explicit


Sub Consolidate()


Dim strAnswer As String
Dim ws As Worksheet
Dim wsConsol As Worksheet
Dim lngLastRow As Long
Dim lngNextRow As Long
Dim lngChar As Long
Dim varOK As Variant
Dim strParts() As String
Dim strP() As String
Dim strRange As String
Dim rngCopy As Range
Dim intPart As Integer
Dim lngArea As Long


varOK = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "-", ",")


strAnswer = InputBox("Please enter the columns you would like to consolidate. Valid characters are letters, comma and dash", "Colsolidate Columns", "A-Z")
strAnswer = UCase(strAnswer)
' Get rid of spaces
strAnswer = Replace(strAnswer, " ", "")


For lngChar = 0 To 27
    If Not isInArray(Mid$(strAnswer, lngChar + 1, 1), varOK) Then
        MsgBox "Found unexpected character '" & Mid$(strAnswer, lngChar + 1, 1) & "' in answer. Valid are A to Z, comma and dash", vbOKOnly, "Invalid Input"
        Exit Sub
    End If
Next


' Replace dash with colon to make range formation easier
strAnswer = Replace(strAnswer, "-", ":")


' Validate that a range is in order. In other words reject ranges like J:B
If Not isInAlphaOrder(strAnswer) Then
    Exit Sub
End If


' Break into parts at the commas
strParts = Split(strAnswer, ",")


' Create the range template. The 99 will be replaced as we iterate the worksheets.
If InStr(strParts(0), ":") = 0 Then
    strRange = strParts(intPart) & "2" & ":" & strParts(intPart) & "99"
Else
    strP = Split(strParts(0), ":")
    strRange = strP(0) & "2" & ":" & strP(1) & "99"
End If
For intPart = 1 To UBound(strParts)
    If InStr(strParts(intPart), ":") = 0 Then
        strRange = strRange & "," & strParts(intPart) & "2" & ":" & strParts(intPart) & "99"
    Else
        strP = Split(strParts(intPart), ":")
        strRange = strRange & "," & strP(0) & "2" & ":" & strP(1) & "99"
    End If
Next


Set wsConsol = ThisWorkbook.Worksheets("Consol")
'wsConsol.UsedRange.Cells.Offset(1, 0).ClearContents


Application.ScreenUpdating = False


For Each ws In ThisWorkbook.Worksheets
    With ws
        Select Case True
            Case ws.Name = "Consol" ' Ignore the Consol sheet
            Case ws.Visible = False ' Ignore hidden sheets
            Case Else
                lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                lngNextRow = wsConsol.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                ' Replace 99 in the template with the actual last row
                strRange = Replace(strRange, "99", lngLastRow)
                For lngArea = 1 To Range(strRange).Areas.Count
                    .Range(strRange).Areas(lngArea).Copy Destination:=wsConsol.Cells(lngNextRow, Range(strRange).Areas(lngArea).Column)
                Next
        End Select
    End With
Next


wsConsol.Activate


Application.ScreenUpdating = True
End Sub
Private Function isInArray(stringToBeFound As String, arr As Variant) As Boolean
    isInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Private Function isInAlphaOrder(strAnswer As String) As Boolean
Dim strParts() As String
Dim intPart As Integer


isInAlphaOrder = True


strParts = Split(strAnswer, ",")


For intPart = 0 To UBound(strParts)
    If InStr(strParts(intPart), ":") > 0 Then
        If Split(strParts(intPart), ":")(0) > Split(strParts(intPart), ":")(1) Then
            isInAlphaOrder = False
            MsgBox "Answer contains range '" & Replace(strParts(intPart), ":", "-") & "' which is out of order"
            Exit Function
        End If
    End If
Next
End Function
However, there is this error - which is the same as i stated in my previous comment - https://www.experts-exchange.com/questions/29186244/Consolidate-all-data-from-various-sheets-into-1-sheet-with-customised-prompt.html#a43118426 


Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I made a couple of changes.
Option Explicit

Sub Consolidate()


Dim strAnswer As String
Dim ws As Worksheet
Dim wsConsol As Worksheet
Dim lngLastRow As Long
Dim lngNextRow As Long
Dim lngChar As Long
Dim varOK As Variant
Dim strParts() As String
Dim strP() As String
Dim strRange As String
Dim rngCopy As Range
Dim intPart As Integer
Dim lngArea As Long


varOK = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "-", ",")


strAnswer = InputBox("Please enter the columns you would like to consolidate. Valid characters are letters, comma and dash", "Colsolidate Columns", "A-Z")
strAnswer = UCase(strAnswer)
' Get rid of spaces
strAnswer = Replace(strAnswer, " ", "")


For lngChar = 0 To 27
    If Not isInArray(Mid$(strAnswer, lngChar + 1, 1), varOK) Then
        MsgBox "Found unexpected character '" & Mid$(strAnswer, lngChar + 1, 1) & "' in answer. Valid are A to Z, comma and dash", vbOKOnly, "Invalid Input"
        Exit Sub
    End If
Next


' Replace dash with colon to make range formation easier
strAnswer = Replace(strAnswer, "-", ":")


' Validate that a range is in order. In other words reject ranges like J:B
If Not isInAlphaOrder(strAnswer) Then
    Exit Sub
End If


' Break into parts at the commas
strParts = Split(strAnswer, ",")


' Create the range template. The 99 will be replaced as we iterate the worksheets.
If InStr(strParts(0), ":") = 0 Then
    strRange = strParts(intPart) & "2" & ":" & strParts(intPart) & "99"
Else
    strP = Split(strParts(0), ":")
    strRange = strP(0) & "2" & ":" & strP(1) & "99"
End If
For intPart = 1 To UBound(strParts)
    If InStr(strParts(intPart), ":") = 0 Then
        strRange = strRange & "," & strParts(intPart) & "2" & ":" & strParts(intPart) & "99"
    Else
        strP = Split(strParts(intPart), ":")
        strRange = strRange & "," & strP(0) & "2" & ":" & strP(1) & "99"
    End If
Next


Set wsConsol = ThisWorkbook.Worksheets("Consol")
'wsConsol.UsedRange.Cells.Offset(1, 0).ClearContents


Application.ScreenUpdating = False


For Each ws In ThisWorkbook.Worksheets
    With ws
        Select Case True
            Case ws.Name = "Consol" ' Ignore the Consol sheet
            Case ws.Visible = False ' Ignore hidden sheets
            Case Else
                lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If WorksheetFunction.CountA(wsConsol.UsedRange) > 0 Then
                    lngNextRow = wsConsol.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                Else
                    lngNextRow = 1
                End If
                ' Replace 99 in the template with the actual last row
                strRange = Replace(strRange, "99", lngLastRow)
                For lngArea = 1 To Range(strRange).Areas.Count
                    .Range(strRange).Areas(lngArea).Copy Destination:=wsConsol.Cells(lngNextRow, Range(strRange).Areas(lngArea).Column)
                Next
        End Select
    End With
Next


wsConsol.Activate


Application.ScreenUpdating = True
End Sub
Private Function isInArray(stringToBeFound As String, arr As Variant) As Boolean
    isInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Private Function isInAlphaOrder(strAnswer As String) As Boolean
Dim strParts() As String
Dim intPart As Integer


isInAlphaOrder = True


strParts = Split(strAnswer, ",")


For intPart = 0 To UBound(strParts)
    If InStr(strParts(intPart), ":") > 0 Then
        If Split(strParts(intPart), ":")(0) > Split(strParts(intPart), ":")(1) Then
            isInAlphaOrder = False
            MsgBox "Answer contains range '" & Replace(strParts(intPart), ":", "-") & "' which is out of order"
            Exit Function
        End If
    End If
Next
End Function

Open in new window

Author

Commented:
@Martin Liss, this code is working but only partial :
1. I have 2 worksheets "2017" and "2018" to consolidate into "Consol"
All data are copied in "2017" but for "2018" it only copied till row 306 which is the same number of rows as "2017" but in "2017" there are 306 rows but for "2018", there are 325 rows. The macro should copy all the data from "2017" and "2018" and should not limit to follow the 1st worksheet rows.

2. code working only if i use it within the workbook. If i were to copy the code into PERSONAL.xlsb and run from there, it will have the error message :

but i checked my worksheet name is "Consol" so what could have gone wrong that it doesn't work when i run via PERSONAL.xlsb ?

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Try changing te yellow line to Set wsConsol = Worksheets("Consol") or Set wsConsol = ActiveWorkbook.Worksheets("Consol").

Author

Commented:
Try changing the yellow line to Set wsConsol = Worksheets("Consol") or Set wsConsol = ActiveWorkbook.Worksheets("Consol")
1. The above works for running the macro WITHIN the workbook but does not copy all the rows as i mentioned in the comment above in 1.  - https://www.experts-exchange.com/questions/29186244/Consolidate-all-data-from-various-sheets-into-1-sheet-with-customised-prompt.html#a43129195 

2.Set wsConsol = Worksheets("Consol")  OR
Set wsConsol = ActiveWorkbook.Worksheets("Consol").
 
Does not help when running from PERSONAL.xlsb.
i tried both ways, it gives the same following error :






Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
The code below works for me from Personal.xlsb and it copies all the data. I could not however reproduce the run-time error 91 you reported. If it happens again place your cursor over the ws.Name in the Case ws.Name = "Consol" ' Ignore the Consol sheet line and that will show you the name of the sheet that has the problem. Is there anything unusual about that sheet?
Sub Colsolidate()

Dim strAnswer As String
Dim ws As Worksheet
Dim wsConsol As Worksheet
Dim lngLastRow As Long
Dim lngNextRow As Long
Dim lngChar As Long
Dim varOK As Variant
Dim strParts() As String
Dim strP() As String
Dim strRange As String
Dim rngCopy As Range
Dim intPart As Integer
Dim lngArea As Long

varOK = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "-", ",")

strAnswer = InputBox("Please enter the columns you would like to consolidate. Valid characters are letters, comma and dash", "Colsolidate Columns", "A-Z")
strAnswer = UCase(strAnswer)
' Get rid of spaces
strAnswer = Replace(strAnswer, " ", "")

For lngChar = 0 To 27
    If Not isInArray(Mid$(strAnswer, lngChar + 1, 1), varOK) Then
        MsgBox "Found unexpected character '" & Mid$(strAnswer, lngChar + 1, 1) & "' in answer. Valid are A to Z, comma and dash", vbOKOnly, "Invalid Input"
        Exit Sub
    End If
Next

' Replace dash with colon to make range formation easier
strAnswer = Replace(strAnswer, "-", ":")

' Validate that a range is in order. In other words reject ranges like J:B
If Not isInAlphaOrder(strAnswer) Then
    Exit Sub
End If

' Break into parts at the commas
strParts = Split(strAnswer, ",")

' Create the range template. The 99 will be replaced as we iterate the worksheets.
If InStr(strParts(0), ":") = 0 Then
    strRange = strParts(intPart) & "2" & ":" & strParts(intPart) & "99"
Else
    strP = Split(strParts(0), ":")
    strRange = strP(0) & "2" & ":" & strP(1) & "99"
End If
For intPart = 1 To UBound(strParts)
    If InStr(strParts(intPart), ":") = 0 Then
        strRange = strRange & "," & strParts(intPart) & "2" & ":" & strParts(intPart) & "99"
    Else
        strP = Split(strParts(intPart), ":")
        strRange = strRange & "," & strP(0) & "2" & ":" & strP(1) & "99"
    End If
Next

Set wsConsol = Worksheets("Consol")
'wsConsol.UsedRange.Cells.Offset(1, 0).ClearContents

Application.ScreenUpdating = False

For Each ws In Worksheets
    With ws
        Select Case True
            Case ws.Name = "Consol" ' Ignore the Consol sheet
            Case ws.Visible = False ' Ignore hidden sheets
            Case Else
                lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                lngNextRow = wsConsol.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                ' Replace 99 in the template with the actual last row
                strRange = Replace(strRange, "99", lngLastRow)
                For lngArea = 1 To Range(strRange).Areas.Count
                    .Range(strRange).Areas(lngArea).Copy Destination:=wsConsol.Cells(lngNextRow, Range(strRange).Areas(lngArea).Column)
                    strRange = Replace(strRange, lngLastRow, "99")
                Next
        End Select
    End With
Next

wsConsol.Activate

Application.ScreenUpdating = True
End Sub

Open in new window

Author

Commented:
@Martin Liss
I am having different error with your code above. This time is even worse, i am having same error even when i am using the code within the worksheet:






Anyway, I will just use your previous code within the worksheet and not place it in PERSONAL.xlsb to avoid wasting more efforts.

The code that works within the worksheet is as follows:
Sub Consolidate() '21 July


Dim strAnswer As String
Dim ws As Worksheet
Dim wsConsol As Worksheet
Dim lngLastRow As Long
Dim lngNextRow As Long
Dim lngChar As Long
Dim varOK As Variant
Dim strParts() As String
Dim strP() As String
Dim strRange As String
Dim rngCopy As Range
Dim intPart As Integer
Dim lngArea As Long


varOK = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "-", ",")


strAnswer = InputBox("Please enter the columns you would like to consolidate. Valid characters are letters, comma and dash", "Colsolidate Columns", "A-Z")
strAnswer = UCase(strAnswer)
' Get rid of spaces
strAnswer = Replace(strAnswer, " ", "")


For lngChar = 0 To 27
    If Not isInArray(Mid$(strAnswer, lngChar + 1, 1), varOK) Then
        MsgBox "Found unexpected character '" & Mid$(strAnswer, lngChar + 1, 1) & "' in answer. Valid are A to Z, comma and dash", vbOKOnly, "Invalid Input"
        Exit Sub
    End If
Next


' Replace dash with colon to make range formation easier
strAnswer = Replace(strAnswer, "-", ":")


' Validate that a range is in order. In other words reject ranges like J:B
If Not isInAlphaOrder(strAnswer) Then
    Exit Sub
End If


' Break into parts at the commas
strParts = Split(strAnswer, ",")


' Create the range template. The 99 will be replaced as we iterate the worksheets.
If InStr(strParts(0), ":") = 0 Then
    strRange = strParts(intPart) & "2" & ":" & strParts(intPart) & "99"
Else
    strP = Split(strParts(0), ":")
    strRange = strP(0) & "2" & ":" & strP(1) & "99"
End If
For intPart = 1 To UBound(strParts)
    If InStr(strParts(intPart), ":") = 0 Then
        strRange = strRange & "," & strParts(intPart) & "2" & ":" & strParts(intPart) & "99"
    Else
        strP = Split(strParts(intPart), ":")
        strRange = strRange & "," & strP(0) & "2" & ":" & strP(1) & "99"
    End If
Next


'Set wsConsol = ThisWorkbook.Worksheets("Consol") - of if use within the macro
'Set wsConsol = Worksheets("Consol")- OK if use within the macro
Set wsConsol = ActiveWorkbook.Worksheets("Consol")

'wsConsol.UsedRange.Cells.Offset(1, 0).ClearContents


Application.ScreenUpdating = False


For Each ws In ThisWorkbook.Worksheets
    With ws
        Select Case True
            Case ws.Name = "Consol" ' Ignore the Consol sheet
            Case ws.Visible = False ' Ignore hidden sheets
            Case Else
                lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If WorksheetFunction.CountA(wsConsol.UsedRange) > 0 Then
                    lngNextRow = wsConsol.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                Else
                    lngNextRow = 1
                End If
                ' Replace 99 in the template with the actual last row
                strRange = Replace(strRange, "99", lngLastRow)
                For lngArea = 1 To Range(strRange).Areas.Count
                    .Range(strRange).Areas(lngArea).Copy Destination:=wsConsol.Cells(lngNextRow, Range(strRange).Areas(lngArea).Column)
                Next
        End Select
    End With
Next


wsConsol.Activate


Application.ScreenUpdating = True
End Sub
Private Function isInArray(stringToBeFound As String, arr As Variant) As Boolean
    isInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Private Function isInAlphaOrder(strAnswer As String) As Boolean
Dim strParts() As String
Dim intPart As Integer


isInAlphaOrder = True


strParts = Split(strAnswer, ",")


For intPart = 0 To UBound(strParts)
    If InStr(strParts(intPart), ":") > 0 Then
        If Split(strParts(intPart), ":")(0) > Split(strParts(intPart), ":")(1) Then
            isInAlphaOrder = False
            MsgBox "Answer contains range '" & Replace(strParts(intPart), ":", "-") & "' which is out of order"
            Exit Function
        End If
    End If
Next
End Function

I just need to ensure that this code covers ALL the data:

@Martin Liss, this code is working but only partial :
1. I have 2 worksheets "2017" and "2018" to consolidate into "Consol"
All data are copied in "2017" but for "2018" it only copied till row 306 which is the same number of rows as "2017" but in "2017" there are 306 rows but for "2018", there are 325 rows. The macro should copy all the data from "2017" and "2018" and should not limit to follow the 1st worksheet rows.
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
The code that you posted above labeled with the  "21 July" comment in row 1 is not the same as the most recent code which I posted here.

You also seem to be missing the isInArray function so add theis to your Personal.xlsb file
Function isInArray(stringToBeFound As String, arr As Variant) As Boolean
    isInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Open in new window

Author

Commented:
Where do you paste this code?

You also seem to be missing the isInArray function so add theis to your Personal.xlsb file
Function isInArray(stringToBeFound As String, arr As Variant) As Boolean
    isInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
The above code is also not found in the following :
not the same as the most recent codewhich I posted here. 


Please post the FULL code here to avoid misinterpretation. Thanks.
Social distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
@Martin Liss, i know the reason for this error stated in this comment now https://www.experts-exchange.com/questions/29186244/Consolidate-all-data-from-various-sheets-into-1-sheet-with-customised-prompt.html#a43125063 

Because there are no headers in the "Consol" worksheet.
Once i copied the headers into the Consol worksheet before invoking the macro, then the marco works.
I have accepted your macro as the solution. 

Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I’m glad I was able to help.

If you expand the “Full Biography" section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2019
              Experts Exchange Top Expert VBA 2018, 2019
              Experts Exchange Distinguished Expert in Excel 2018

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.