Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Consolidating a list

Posted on 2011-09-18
4
Medium Priority
?
202 Views
Last Modified: 2012-06-27
EE Professionals,

I have a number of text entries that are in a column but at different point/cells that have blanks between them.  When the data refreshes, the entries change and so do the locations of the data; although it's still within a range within the same column.  What I'm looking for is the formula that looks at a column and takes all of the text entries and lists them in sheet 2 in a single, list (no blanks).

Example:

Cells in Sheet 1 are in Column D and in Rows 4, 5, 8, 12, 14 and 18.  What I'm looking for is in Sheet 2, Column D, the text on Sheet 1, is put in Rows 4, 5, 6, 7, 8 and 9 (single list).  

Thank you!

B.
0
Comment
Question by:Bright01
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 42

Expert Comment

by:dlmille
ID: 36557521
Ok - app searches column D sheet1, omitting first row as header?  then outputs results in column D sheet2 (appending), from second row forward, without blank rows.

Here's the code:
 
Sub removeBlkDiffSht()
Dim wkb As Workbook
Dim srcSht As Worksheet
Dim destSht As Worksheet
Dim outCursor As Range
Dim fRange As Range
Dim lastRow As Long
Dim firstAddress As String

    Set wkb = ThisWorkbook
    Set srcSht = wkb.Sheets("Sheet1")
    Set destSht = wkb.Sheets("Sheet2")
    Set outCursor = destSht.Range("D" & destSht.Rows.Count).End(xlUp).Offset(1, 0) 'append to column D
    
    lastRow = srcSht.Range("D" & srcSht.Rows.Count).End(xlUp).Row
    
    'omit first row?
    With srcSht.Range("D2:D" & lastRow)
    
        Set fRange = .Find(what:="*")
        If Not fRange Is Nothing Then
            firstAddress = fRange.Address
            
            Do
            
                outCursor.Value = fRange.Value
                Set outCursor = outCursor.Offset(1, 0)
                
                Set fRange = .FindNext(fRange)
            Loop While Not fRange Is Nothing And firstAddress <> fRange.Address
        End If
    End With
    
End Sub

Open in new window


See attached demo workbook.

Enjoy!

Dave
removeBlanksToSht2-r1.xlsm
0
 

Author Comment

by:Bright01
ID: 36559527
Dave,

This is great...... however, one problem that I found that I missed when I first posed the question; when I test it it put the blanks in on the output for me..... and the reason why is that I have formulas in the cells that are both populated and blank on the source sheet.  Is there a way to distinguish "results" from cells with formulas?  Just to be clear; in the source cells, there are is a formula that either populates or leaves blank the cell.  If the cell is blank the formula is still there. So the code you wrote sees the cell as "populated" and displays it anyway on the output sheet.

The formula in the fields in the cells, blank or populated is; =IF(ROW()>=(ROW(Priority_Formulas!$D$4)+SUM(Priority_Formulas!$B$2:$B$12)-1),"",IF(Priority_Formulas!G6>0,"",INDEX(INDEX(PriorityDB!$E:$E,MATCH(Strategic_Priorities!$B$1,PriorityDB!$A:$A,0)):INDEX(PriorityDB!$E:$E,MATCH(Strategic_Priorities!$B$1,PriorityDB!$A:$A,1)),ROW(Priority_Formulas!A3)+Priority_Formulas!$B$2-(SUM(Priority_Formulas!$G$4:G6)))))

Sorry for the additional confusion.  Thank you.

B.
0
 
LVL 42

Accepted Solution

by:
dlmille earned 2000 total points
ID: 36561410
Ok - I put a test to ensure the result was = "" before skipping.

 
Sub removeBlkDiffSht()
Dim wkb As Workbook
Dim srcSht As Worksheet
Dim destSht As Worksheet
Dim outCursor As Range
Dim fRange As Range
Dim lastRow As Long
Dim firstAddress As String

    Set wkb = ThisWorkbook
    Set srcSht = wkb.Sheets("Sheet1")
    Set destSht = wkb.Sheets("Sheet2")
    Set outCursor = destSht.Range("D" & destSht.Rows.Count).End(xlUp).Offset(1, 0) 'append to column D
    
    lastRow = srcSht.Range("D" & srcSht.Rows.Count).End(xlUp).Row
    
    'omit first row?
    With srcSht.Range("D2:D" & lastRow)
    
        Set fRange = .Find(what:="*")
        If Not fRange Is Nothing Then
            firstAddress = fRange.Address
            
            Do
                If fRange.Value <> "" Then
                    outCursor.Value = fRange.Value
                    Set outCursor = outCursor.Offset(1, 0)
                End If
                
                Set fRange = .FindNext(fRange)
            Loop While Not fRange Is Nothing And firstAddress <> fRange.Address
        End If
    End With
    
End Sub

Open in new window

removeBlanksToSht2-r2.xlsm
0
 

Author Closing Comment

by:Bright01
ID: 36561562
Dave,

Great work as always...... and I could even follow it in the code!  Much thanks.  Hope you have a great week.

All the best,

B.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question