Solved

Consolidating a list

Posted on 2011-09-18
4
176 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
  • 2
  • 2
4 Comments
 
LVL 41

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 41

Accepted Solution

by:
dlmille earned 500 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

864 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

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now