CODEWITHSUNDEEP
excelvba
PeepDeep
PeepDeep

Reputation: 53

Excel VBA to copy only non blank rows from specific column

Making a sheet where the user can select an area from a drop down, and then cells containing info relevant to that area are shown in column T.

The data is formatted in such a way that the areas are the headings across the columns from A1:Q1. Then on each column is a combination of blank cells and cells that contain the info needed.

This shows a simplified example of what I'd like to do. Obviously the X's pertain to actual info.

enter image description here

I've got a code that I think should work, but it's not.... The first section does successfully find the right column from the sheet using whatever is in the drop down. But then the copy paste loop that looks for blank cells does not seem happy, and doesn't want to use the address I found from the find section.

I did explore the idea of using index/match/array, but couldn't get my head round it.

Sub NonBlank()

Dim Found As Range
Dim Clm As String
Dim rngSearch As Range
Dim Criteria As Variant
Dim cell As Range





Criteria = Sheets("Example").Range("S3").Value

Set rngSearch = Sheets("Example").Range("A1:Q1")

Set Found = rngSearch.Find(What:=Criteria, _
                               LookIn:=xlValues, _
                               LookAt:=xlWhole, _
                               SearchOrder:=xlByColumns, _
                               SearchDirection:=xlNext, _
                               MatchCase:=False)
                               

If Not Found Is Nothing Then

Clm = Found.Address(rowabsolute:=False)


Dim datatocopy As Range
Set datatocopy = Sheets("example").Range("clm").SpecialCells(xlCellTypeConstants)

If Not datatocopy Is Nothing Then
    datatocopy.Copy Destination:=Sheets("Example").Range("T3")

End If

End If


End Sub

Any help is much appreciated. :)

Upvotes: 0

Views: 2574

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

If the values are constants and no formulas you don't need to loop through the data and can just use SpecialCells(xlCellTypeConstants) on the range to get all constant values (without the blank cells).

Dim DataToCopy As Range
Set DataToCopy = Sheets("Table").Range("B1:B6").SpecialCells(xlCellTypeConstants)

If Not DataToCopy Is Nothing Then
    DataToCopy.Copy Destination:=Sheets("Table").Range("G2")
End If

The following should work

Sub NonBlank()   
    Dim Criteria As Variant
    Criteria = Sheets("Example").Range("S3").Value

    Dim rngSearch As Range
    Set rngSearch = Sheets("Example").Range("A1:Q1")
    
    Dim Found As Range
    Set Found = rngSearch.Find(What:=Criteria, _
                                   LookIn:=xlValues, _
                                   LookAt:=xlWhole, _
                                   SearchOrder:=xlByColumns, _
                                   SearchDirection:=xlNext, _
                                   MatchCase:=False)

    If Not Found Is Nothing Then
        Dim datatocopy As Range
        Set datatocopy = Found.EntireColumn.Resize(RowSize:=Rows.Count-1).Offset(RowOffset:=1).SpecialCells(xlCellTypeConstants)
    
        If Not datatocopy Is Nothing Then
            datatocopy.Copy Destination:=Sheets("Example").Range("T3")
        End If        
    End If
End Sub

Upvotes: 1

Related Questions