Summarising row data into a separate column

kamruk

New Member
Joined
Oct 28, 2015
Messages
5
Hi,

I am trying to take string data from multiple sheets that is listed in the same row each time, and summarise it in a column (or row), while removing any gaps. There may be a quite obvious fix, but I have found no solution.

So I have data that looks like this:

Sheet 1

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Cow[/TD]
[TD][/TD]
[TD]Chicken[/TD]
[TD][/TD]
[TD]Barn[/TD]
[/TR]
</tbody>[/TABLE]

Sheet 2

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]Pig[/TD]
[TD][/TD]
[TD][/TD]
[TD]Sheep[/TD]
[/TR]
</tbody>[/TABLE]

...

etc.

And would like to then on my final sheet (let's say I only have 2 sheets of data and one final 3rd sheet) a summary of everything from the specific shown row, excluding any gaps e.g.:

Sheet 3

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Summary[/TD]
[/TR]
[TR]
[TD]Cow[/TD]
[/TR]
[TR]
[TD]Chicken[/TD]
[/TR]
[TR]
[TD]Barn[/TD]
[/TR]
[TR]
[TD]Pig[/TD]
[/TR]
[TR]
[TD]Sheep[/TD]
[/TR]
</tbody>[/TABLE]

Would this be possible? Any help is appreciated!
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Hi,

I am trying to take string data from multiple sheets that is listed in the same row each time, and summarise it in a column (or row), while removing any gaps. There may be a quite obvious fix, but I have found no solution.

So I have data that looks like this:

Sheet 1

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Cow[/TD]
[TD][/TD]
[TD]Chicken[/TD]
[TD][/TD]
[TD]Barn[/TD]
[/TR]
</tbody>[/TABLE]

Sheet 2

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]Pig[/TD]
[TD][/TD]
[TD][/TD]
[TD]Sheep[/TD]
[/TR]
</tbody>[/TABLE]

...

etc.

And would like to then on my final sheet (let's say I only have 2 sheets of data and one final 3rd sheet) a summary of everything from the specific shown row, excluding any gaps e.g.:

Sheet 3

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Summary[/TD]
[/TR]
[TR]
[TD]Cow[/TD]
[/TR]
[TR]
[TD]Chicken[/TD]
[/TR]
[TR]
[TD]Barn[/TD]
[/TR]
[TR]
[TD]Pig[/TD]
[/TR]
[TR]
[TD]Sheep[/TD]
[/TR]
</tbody>[/TABLE]

Would this be possible? Any help is appreciated!
Hi Kamruk, welcome to the boards.

Just to check, is VBA an option here?
 
Upvote 0
Hi Fishboy, thank you!

VBA's wouldn't be an issue, unless there's a simpler solution :D
Hmm, I seem to be having some difficulty with this one. I have attempted to amend a tried and tested "For each cell in range" type of macro which has worked countless times for me when the range was vertical, however when I have tried to apply the same logic to a horizontal range it only seems to look at the last value.

For testing purposes I am only looking at copying the non-blank cells from Sheet1 at present, using the following code:

Rich (BB code):
Sub TEST()
' Defines variables
Dim Cell, cRange1, cRange2 As Range
' Defines last row of Sheet3 for pasting purposes
LastRow = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
' Sets the first check range as Sheet1 Row 1
Set cRange1 = Sheets("Sheet1").Range("1:1")
' For each cell in check range 1
    For Each Cell In cRange1
' If cell is not blank then...
        If Cell.Value <> "" Then
' Copy the cell to the next blank row in column A of Sheet3
            Cell.Copy Destination:=Sheets("Sheet3").Range("A" & LastRow + 1)
        End If
' Check next cell in range
    Next Cell
End Sub

Now using your simple example above (and now below here):


Excel 2010
ABCDE
1CowChickenBarn
Sheet1


My code seems to only copy Barn and I cannot figure out why. I may have to open this up to the rest of the forum as if I can't get it to work properly on a single row, I will not be able to expand it to work on additional rows / sheets etc.
 
Upvote 0
kamruk,

Welcome to the MrExcel forum.

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?


I assume that the three worksheets already exist, and, that Sheet3 range A1 contains Summary

I assume that the search row is row 1. If that is not correct, then you can change the sr variable in the macro, or, I can adjust the macro for which row to work in.

You can change the worksheet names in the macro.


Sample raw data:


Excel 2007
ABCDEF
1CowChickenBarn
2
Sheet1



Excel 2007
ABCDEF
1PigSheep
2
Sheet2


And, after the macro in worksheet Sheet3:


Excel 2007
A
1Summary
2Cow
3Chicken
4Barn
5Pig
6Sheep
7
Sheet3


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Sub UpdateSummary()
' hiker95, 10/28/2015, ME897592
Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet
Dim sr As Long, lc As Long, c As Range, a As Range, nr As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
Set w2 = Sheets("Sheet2")   '<-- you can change the sheet name here
Set w3 = Sheets("Sheet3")   '<-- you can change the sheet name here
sr = 1
With w1
  lc = .Cells(sr, .Columns.Count).End(xlToLeft).Column
  For Each c In .Range(.Cells(1, sr), .Cells(sr, lc))
    If Not c = vbEmpty Then
      Set a = w3.Columns(1).Find(c.Value, LookAt:=xlWhole)
      If a Is Nothing Then
        nr = w3.Cells(w3.Rows.Count, "A").End(xlUp).Row + 1
        w3.Cells(nr, 1).Value = c.Value
      End If
    End If
  Next c
End With
With w2
  lc = .Cells(sr, .Columns.Count).End(xlToLeft).Column
  For Each c In .Range(.Cells(1, sr), .Cells(sr, lc))
    If Not c = vbEmpty Then
      Set a = w3.Columns(1).Find(c.Value, LookAt:=xlWhole)
      If a Is Nothing Then
        nr = w3.Cells(w3.Rows.Count, "A").End(xlUp).Row + 1
        w3.Cells(nr, 1).Value = c.Value
      End If
    End If
  Next c
End With
With w3
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the UpdateSummary macro.
 
Upvote 0
Thanks Fishboy! The whole horizontal nature of list is what really killed it for me too... Although you seem to know a lot better where to start than I do :laugh:

kamruk,

Welcome to the MrExcel forum.

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?


I assume that the three worksheets already exist, and, that Sheet3 range A1 contains Summary

I assume that the search row is row 1. If that is not correct, then you can change the sr variable in the macro, or, I can adjust the macro for which row to work in.

(...)

Then run the UpdateSummary macro.

Hey hiker95, thank you!

I'm using Excel2010 on a Windows 7 PC.

And thank you for the macro, it worked perfectly! The only thing is that I'm not working on row 1 , but row 18. Would you mind highlighting where this needs to be adjusted? I tried, but it appears as if I didn't quite do it right...

Also, in case this is an easy one, would it be possible to have the macro run for n number of sheets and then paste the info on n + 1? I.e. Sheet1, Sheet2, ... Sheetn then the last sheet would be Sheetn + 1 (n being the the number of all sheets -1). Again, only if this is an easy one to pull off. I tried adding multiple "w" values and defining the pages, while bumbing down "w3" to whatever my "n+1" is, with no problem.

Again, thank you so much for your help with this.
 
Upvote 0
Hey hiker95, thank you!

I'm using Excel2010 on a Windows 7 PC.

And thank you for the macro, it worked perfectly!

kamruk,

Thanks for the feedback.

You are very welcome. Glad I could help.
 
Upvote 0
The only thing is that I'm not working on row 1 , but row 18. Would you mind highlighting where this needs to be adjusted? I tried, but it appears as if I didn't quite do it right...

kamruk,

Here is another macro solution for you to consider based on your above quote.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
Sub UpdateSummary_V2()
' hiker95, 10/28/2015, ME897592
Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet
Dim sr As Long, lc As Long, c As Range, a As Range, nr As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
Set w2 = Sheets("Sheet2")   '<-- you can change the sheet name here
Set w3 = Sheets("Sheet3")   '<-- you can change the sheet name here
sr = 18
With w1
  lc = .Cells(sr, .Columns.Count).End(xlToLeft).Column
  For Each c In .Range(.Cells(sr, 1), .Cells(sr, lc))
    If Not c = vbEmpty Then
      Set a = w3.Columns(1).Find(c.Value, LookAt:=xlWhole)
      If a Is Nothing Then
        nr = w3.Cells(w3.Rows.Count, "A").End(xlUp).Row + 1
        w3.Cells(nr, 1).Value = c.Value
      End If
    End If
  Next c
End With
With w2
  lc = .Cells(sr, .Columns.Count).End(xlToLeft).Column
  For Each c In .Range(.Cells(sr, 1), .Cells(sr, lc))
    If Not c = vbEmpty Then
      Set a = w3.Columns(1).Find(c.Value, LookAt:=xlWhole)
      If a Is Nothing Then
        nr = w3.Cells(w3.Rows.Count, "A").End(xlUp).Row + 1
        w3.Cells(nr, 1).Value = c.Value
      End If
    End If
  Next c
End With
With w3
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the UpdateSummary_V2 macro.
 
Upvote 0
Also, in case this is an easy one, would it be possible to have the macro run for n number of sheets and then paste the info on n + 1? I.e. Sheet1, Sheet2, ... Sheetn then the last sheet would be Sheetn + 1 (n being the the number of all sheets -1). Again, only if this is an easy one to pull off. I tried adding multiple "w" values and defining the pages, while bumbing down "w3" to whatever my "n+1" is, with no problem.

kamruk,

In stead of having to track the changing number of worksheets, how about puting the results in a new worksheet, maybe of one the following names?

1. Results

2. Summary

3. Or, some other name
 
Upvote 0
kamruk,

Here is another macro solution for you to consider based on your above quote.

Ah! I had left .Cells(sr, 1) as .Cells(1, sr) - I guess it should have been "sr, 1" anyway but this didn't matter because of "sr = 1"? Thank you, you have literally saved me hours of dealing with this horizontal layout :biggrin:
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

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