Solved Combine Worksheets to Last Column

Microsoft Excel 2010 - complete product...
December 8, 2014 at 10:50:07
Specs: Windows 7 Service Pack 1
I have a macro that combines information from multiple workbooks. I want to do this from (2) different worksheet names. My code is working but it overwrites the information from the 2nd sheet over the first one. I would like to have it look for the last column and then add the information.

Sub MergeWorkbooks2()
    Dim FileNameXls As Variant
    Dim SummWks As Worksheet
    Dim ColNum As Integer
    Dim myCell As Range, Rng As Range
    Dim RwNum As Long, FNum As Long, FinalSlash As Long
    Dim ShName As String, PathStr As String
    Dim SheetCheck As String, JustFileName As String
    Dim JustFolder As String
    Dim destrange As Range
     
    
    ShName = "Est Price Summary"
    Set Rng = Range("B1:B30")    

    'Select the files with GetOpenFilename
    FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _
                                              MultiSelect:=True)

    If IsArray(FileNameXls) = False Then
        'do nothing
    Else
        With Application
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
        End With

        'Add a new workbook with one sheet for the Summary
        Set SummWks = ThisWorkbook.Sheets("Summary")

        'The links to the first workbook will start in row 1
        RwNum = 1
        ColNum = 2

        For FNum = LBound(FileNameXls) To UBound(FileNameXls)
            ColNum = 2
            RwNum = RwNum + 1
            FinalSlash = InStrRev(FileNameXls(FNum), "\")
            JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
            JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)

            'copy the workbook name in column A
            With Rng
            SummWks.Cells(1, RwNum). _
                Resize(, .Columns.Count).Value = JustFileName
            End With
            

            'build the formula string
            JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
            PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"

            On Error Resume Next
            SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
            If Err.Number <> 0 Then
                'If the sheet not exist in the workbook the row color will be Yellow.
                SummWks.Cells(1, ColNum).Resize(1, Rng.Cells.Count + 1) _
                        .Interior.Color = vbYellow
            Else
                For Each myCell In Rng.Cells
                    ColNum = ColNum + 1
                    SummWks.Cells(ColNum, RwNum).Formula = _
                    "=" & PathStr & myCell.Address
                Next myCell
            End If
            On Error GoTo 0
        Next FNum

        ' Use AutoFit to set the column width in the new workbook
        SummWks.UsedRange.Columns.AutoFit

        MsgBox "The Summary is ready, save the file if you want to keep it"

        With Application
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
        End With
    End If
    
    
'Add Est Price Summary-1

    ShName = "Est Price Summary-1"
    Set Rng = Range("B1:B30")   

    'Select the files with GetOpenFilename
    FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _
                                              MultiSelect:=True)

    If IsArray(FileNameXls) = False Then
        'do nothing
    Else
        With Application
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
        End With

        'Add a new workbook with one sheet for the Summary
        Set SummWks = ThisWorkbook.Sheets("Summary")

        'The links to the first workbook will start in row 1
        RwNum = 1
        ColNum = 2

        For FNum = LBound(FileNameXls) To UBound(FileNameXls)
            ColNum = 2
            RwNum = RwNum + 1
            FinalSlash = InStrRev(FileNameXls(FNum), "\")
            JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
            JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)

            'copy the workbook name in column A
            With Rng
            SummWks.Cells(1, RwNum). _
                Resize(, .Columns.Count).Value = JustFileName
            End With
            

            'build the formula string
            JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
            PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"

            On Error Resume Next
            SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
            If Err.Number <> 0 Then
                'If the sheet not exist in the workbook the row color will be Yellow.
                SummWks.Cells(1, ColNum).Resize(1, Rng.Cells.Count + 1) _
                        .Interior.Color = vbYellow
            Else
                For Each myCell In Rng.Cells
                    ColNum = ColNum + 1
                    SummWks.Cells(ColNum, RwNum).Formula = _
                    "=" & PathStr & myCell.Address
                Next myCell
            End If
            On Error GoTo 0
        Next FNum

        ' Use AutoFit to set the column width in the new workbook
        SummWks.UsedRange.Columns.AutoFit

        MsgBox "The Summary is ready, save the file if you want to keep it"

        With Application
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
        End With
    End If
End Sub

Any help would be appreciated.

Thank you,
Sandi


See More: Combine Worksheets to Last Column

Report •


✔ Best Answer
December 10, 2014 at 09:51:05
Since I don't have a copy of your workbook to test this on, the best I could do was supply a generic method for finding the next open column.

I'm going to assume that I know what the problem is, but you'll need to adjust the instructions to match your sheet.

As a review, when I supplied the instruction to find the next Row, I said:

This instruction will basically start at the bottom of Column A and look upwards until it finds data. Once it knows what Row that last piece data is in, it will add 1 to it so that nxtRw is set to the next empty row number.

Now that I've offered the generic instruction to find the next Column, I'll simply reword the explanation:

This instruction will basically start at the far right of Row 1 and look left until it finds data. Once it knows what Column that last piece data is in, it will add 1 to it so that nextCol is set to the next empty column number.

I am assuming that the issue you are having is caused by the Row number that we are using in the nxtCol instruction. Since the Instruction is looking at Row 1 via:

Cells(1, Columns.Count)

I'm guessing that B is the next empty Column in Row 1, since that is where the new data is being placed.

What you probably need to do is determine which Row has the most data after the first part of the code runs and substitute that row number for the "1" in the Cells instruction. That's an easy fix if the "longest" row is constant, such as always Row 2, etc.

If the "longest" row will vary, then we'll need determine which is the longest row each time the macro is run. That's doable, but I'm not going to put in the work until you tell that it needs to be done.

BTW...you might want to check out this How-To. It will provide a number of debugging techniques that might help figure out what is going with your code:

http://www.computing.net/howtos/sho...

message edited by DerbyDad03



#1
December 8, 2014 at 13:40:35
Since I don't have a copy of your workbook to run your code against as a means to seeing the final result, the best I can do is offer a generic solution.

The standard code to find the last Row with data in a given column is as follows. Let's say you want to find the next available Row in Sheet 1, Column A:

nxtRw = Sheets(1).Range("A" & Rows.Count).end(xlup).Row + 1

This instruction will basically start at the bottom of Column A and look upwards until it finds data. Once it knows what Row that last piece data is in, it will add 1 to it so that nxtRw is set to the next empty row number.

Since it looks to me like your code uses ...

RwNum = 1

... as the starting Row in the code sections for both Est Price Summary and Est Price Summary-1, I'm guessing that you need to replace the RwNum = 1 instruction in the section for Est Price Summary-1 with the instruction that finds the next empty Row in the longest column with data based on the sheet layout after the Est Price Summary section was run.

Does that rambling sentence makes sense?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
December 8, 2014 at 13:55:33
That makes sense to copy to the next row but I want it to copy to the next column available and enter it there. So in the sample below the information would be copied into Coumn D.

	
Col A         Col B                           Col C                     Col D
Mix tank	Product Tank              Rinse Tank	
1	2	                 1
KJV	KJV	                 JNA
58.18	99.85	                 100.97
1.75	3.99	                5.05

I hope this makes sense?

Thanks
Sandi


Report •

#3
December 8, 2014 at 15:01:44
Sorry, I'm so used to people asking how to find the last row that I totally missed that you asked for the last column.

nxtCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
December 10, 2014 at 05:08:35
I have been tweaking and trying to get this to work, but it still is not working. It still goes into the 2nd column? I replaced the ColNum = 2 with nxtCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1 and replaced all ColNum with nxtCol. Can you see anything I missed>

    ShName = "Est Price Summary-1"
    Set Rng = Range("B1:B30")    '<---- Change

    'Select the files with GetOpenFilename
    FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _
                                              MultiSelect:=True)

    If IsArray(FileNameXls) = False Then
        'do nothing
    Else
        With Application
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
        End With

        'Add a new workbook with one sheet for the Summary
        Set SummWks = ThisWorkbook.Sheets("Summary")

        'The links to the first workbook will start in row 1
        RwNum = 1
        <b>nxtCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1</b>

        For FNum = LBound(FileNameXls) To UBound(FileNameXls)
            <b>nxtCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1</b>               
            RwNum = RwNum + 1
            FinalSlash = InStrRev(FileNameXls(FNum), "\")
            JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
            JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)

            'copy the workbook name in column A
            With Rng
            SummWks.Cells(1, RwNum). _
                Resize(, .Columns.Count).Value = JustFileName
            End With


            'build the formula string
            JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
            PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"

            On Error Resume Next
            SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
            If Err.Number <> 0 Then
                'If the sheet not exist in the workbook the row color will be Yellow.
                SummWks.Cells(1, <b>nxtCol</b>).Resize(1, Rng.Cells.Count + 1) _
                        .Interior.Color = vbYellow
            Else
                For Each myCell In Rng.Cells
                    <b>nxtCol = nxtCol </b>+ 1
                    SummWks.Cells(<b>nxtCol</b>, RwNum).Formula = _
                    "=" & PathStr & myCell.Address
                Next myCell
            End If
            On Error GoTo 0
        Next FNum

        ' Use AutoFit to set the column width in the new workbook
        SummWks.UsedRange.Columns.AutoFit

        MsgBox "The Summary is ready, save the file if you want to keep it"

        With Application
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
        End With
    End If


Report •

#5
December 10, 2014 at 09:51:05
✔ Best Answer
Since I don't have a copy of your workbook to test this on, the best I could do was supply a generic method for finding the next open column.

I'm going to assume that I know what the problem is, but you'll need to adjust the instructions to match your sheet.

As a review, when I supplied the instruction to find the next Row, I said:

This instruction will basically start at the bottom of Column A and look upwards until it finds data. Once it knows what Row that last piece data is in, it will add 1 to it so that nxtRw is set to the next empty row number.

Now that I've offered the generic instruction to find the next Column, I'll simply reword the explanation:

This instruction will basically start at the far right of Row 1 and look left until it finds data. Once it knows what Column that last piece data is in, it will add 1 to it so that nextCol is set to the next empty column number.

I am assuming that the issue you are having is caused by the Row number that we are using in the nxtCol instruction. Since the Instruction is looking at Row 1 via:

Cells(1, Columns.Count)

I'm guessing that B is the next empty Column in Row 1, since that is where the new data is being placed.

What you probably need to do is determine which Row has the most data after the first part of the code runs and substitute that row number for the "1" in the Cells instruction. That's an easy fix if the "longest" row is constant, such as always Row 2, etc.

If the "longest" row will vary, then we'll need determine which is the longest row each time the macro is run. That's doable, but I'm not going to put in the work until you tell that it needs to be done.

BTW...you might want to check out this How-To. It will provide a number of debugging techniques that might help figure out what is going with your code:

http://www.computing.net/howtos/sho...

message edited by DerbyDad03


Report •

#6
December 12, 2014 at 09:20:51
I still can not get this to work for me no matter what I try. Do you know if there is another way to choose the workbook names you want and Copy a Range into one workbook so that information can be summarized? (1) of the sheets would be "Est Price Summary" and (1) is named "Est Price Summary-1". The range would be B1:B30. I would then like to sum and/or add formulas to the last column.

Thank you,
Sandi


Report •

#7
December 12, 2014 at 11:17:57
Ok....I finally got it :-) I had to changed this part to:

 'copy the workbook name in column A
            With Rng
            <b>SummWks.Cells(1, nxtCol). </b>_
                Resize(, .Columns.Count).Value = JustFileName
            End With

and this one as well:

    For Each myCell In Rng.Cells
                    <b>RwNum = RwNum + 1
                    SummWks.Cells(RwNum, nxtCol).Formula </b>= _
                    "=" & PathStr & myCell.Address
                Next myCell

Now I just need to figure out out to add my formulas to the last column, any ideas on that one? I will keep researching as well, I find a lot of sum rows but very little on summing across rows to the last column.

Thanks again for all of your help!!

message edited by SandiS


Report •

#8
December 12, 2014 at 13:30:45
Ok so the above change works if I only pick one file, if I choose multiples the 2nd sheet will start at line 34 (last row on first one is line 32) instead of 3?

Any ideas?


Report •

#9
December 12, 2014 at 14:17:03
I don't have easy access to Excel since I'm traveling this weekends with just an iPad, so I'm going to guess that the issue is based on the fact that you are not resetting the RwNum variable.

I see RwNum = RwNum + 1 which means that the variable will just keep incrementing. Somewhere along the way you need to reset the variable, probably before you loop back up for the next file.

BTW...as noted in the tutorial that I suggested, you can set a Watch on the RwNum variable and can keep track of its value as you Single Step through the code.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#10
December 15, 2014 at 13:52:04
Ok I believe I got it, add RwNum = 1 and it appears to be working

   For Each myCell In Rng.Cells
                    RwNum = RwNum + 1
                    SummWks.Cells(RwNum, nxtCol).Formula = _
                    "=" & PathStr & myCell.Address
              
                Next myCell
                    RwNum = 1
            End If

edited by moderator: Removed new question, suggested new thread


Report •

#11
December 16, 2014 at 03:53:04
Since this question is not related to the original question in this thread, it should be posted in a new thread, with a relevant subject line. That will help keep the archives organized.

Please start a new thread for this question.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#12
December 16, 2014 at 04:59:12
I will start a new thread...

Thank you!
Sandi


Report •

Ask Question