Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Consolidating a list

Posted on 2011-09-18
4
Medium Priority
?
205 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 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

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

885 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