Move data from 3 columns to 1 column w/o transfer of blanks

[davidryoung]

I know very little about using VB but am pretty sure this is what I need. I am linking several worksheets together and to do so I need to be able to transfer the data from three columns into 1 single column w/o transferring the blanks/0s. All the following worksheets rely on this single column of data to self populate and blanks are not acceptable. Any help would be greatly appreciated.

 

[Zack Barresse]

Hi David, welcome to the board!


What kind of data are you talking about here? Textual? Numerical? A couple of ways, which you may be able to get your code from recording macros, is 1) copy entire range, paste, select blank cells only (special cells) and delete them, or 2) Autofilter data, copy visible cells then paste to destination range.

Either solutions are quite viable and fairly efficient. Imo it would depend on your data structure and the surrounding environments as to which one I would choose. If you describe a little further or choose one we can continue with a more developed solution.


HTH

 

[davidryoung]

The data is text which is seperated into 3 columns (knowns,unknowns,diff). This is simply an input page which begins populating some of the other worksheet forms. The problem I have is that some of the forms are in columns( not a problem) and some are in rows (big problem). I can link individual cells but cannot afford to have any blank cells in any of the self populated forms. The orignial 3 columns of data can vary as to the number of entries as well. I have tried using some variations of the suggestions you've given but dont think these are advanced enough as they still copy "zeros" to the new cells or if cells are deleted, the other forms that have been linked to that cell return errors.

 

[Zack Barresse]

Okay, so assuming that I have data in three columns of Sheet1, cols A, B and C. I have data in A2:C30. Not all cells have data (blank) and some cells contain 0 values. I am going to copy all data, one column at a time, without blanks or zero values to Sheet2 starting in A2 (A1 will be a header). Use something like this ...

Option Explicit

Sub GiveMeTheData()
    Dim filterRng As Range, copyRng As Range, i As Long, lRow As Long
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
        For i = 1 To 3 'columns A to C
            Set filterRng = .Range(.Cells(2, i), _
                .Cells(.Range("A65536").End(xlUp).Row, i))
            filterRng.AutoFilter Field:=1, Criteria1:="<>0"
            Set copyRng = filterRng.SpecialCells(xlCellTypeVisible)
            copyRng.Copy Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1)
        Next i
        .Cells.AutoFilter
    End With
    With Sheets("Sheet2")
        .Range("A1", .Range("A65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).Delete
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Does this help?

 

[Aladin Akyurek]

The data is text which is seperated into 3 columns (knowns,unknowns,diff). This is simply an input page which begins populating some of the other worksheet forms. The problem I have is that some of the forms are in columns( not a problem) and some are in rows (big problem). I can link individual cells but cannot afford to have any blank cells in any of the self populated forms. The orignial 3 columns of data can vary as to the number of entries as well. I have tried using some variations of the suggestions you've given but dont think these are advanced enough as they still copy "zeros" to the new cells or if cells are deleted, the other forms that have been linked to that cell return errors.

Do you want to keep duplicates or eliminate them?

 

[RobShaw]

I'm not sure if i've understood you correctly, but would the three columns only have one value per row, i.e. for each row there would only be one cell with somethign in it in 1 of the three columns

A B C
#
#
#

Not
A B C
# # - wrong?
#
#

 

[RobShaw]

sorry the spaces all reduce to a single space but the example still works (luckily) is this what you mean

 

[davidryoung]

This macro is just what I needed, and I adapted it to just transfer to another column on the first sheet. The only problem I am having is it is only transferring the data in columns A,B,C down through row 11. The data in A,B,C can vary by 1-50 rows in each column, depending on the number of samples I'm dealing with. This is all I changed.
Option Explicit

Sub GiveMeTheData()
Dim filterRng As Range, copyRng As Range, i As Long, lRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Sheets("Samples")
For i = 1 To 3 'columns A to C
Set filterRng = .Range(.Cells(2, i), _
.Cells(.Range("A65536").End(xlUp).Row, i))
filterRng.AutoFilter Field:=1, Criteria1:="<>0"
Set copyRng = filterRng.SpecialCells(xlCellTypeVisible)
copyRng.Copy Sheets("Samples").Range("E65536").End(xlUp).Offset(1)
Next i
.Cells.AutoFilter
End With
With Sheets("Samples")
.Range("E1", .Range("E65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).Delete
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Zack Barresse]

Okay, yes, my fault. I set the last row as the row in column A - not dynamic. I apologize. Try this ...

Option Explicit

Sub GiveMeTheData()
    Dim filterRng As Range, copyRng As Range, i As Long, lRow As Long
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With Sheets("Samples")
        For i = 1 To 3 'columns A to C
'-------------------------------------------------------------------------
            Set filterRng = .Range(.Cells(2, i), _
                .Cells(.Cells(65536, i).End(xlUp).Row, i))
'-------------------------------------------------------------------------
            filterRng.AutoFilter Field:=1, Criteria1:="<>0"
            Set copyRng = filterRng.SpecialCells(xlCellTypeVisible)
            copyRng.Copy Sheets("Samples").Range("E65536").End(xlUp).Offset(1)
        Next i
        .Cells.AutoFilter
    End With
    With Sheets("Samples")
        .Range("E1", .Range("E65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).Delete
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[davidryoung]

That did it. I wish I had asked this question two weeks ago instead of trying to all those IF statements that never quite worked.

Thanks a million for all the help. I know where to come next time.