Solved

Consolidating a list

Posted on 2011-09-18
4
163 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

771 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

14 Experts available now in Live!

Get 1:1 Help Now