Using if statements in loop macros, skip blanks

N

nuckfuts

New Member
Joined
Mar 10, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
I have a worksheet that contains data in column A. I'd like to loop through each cell (beginning at cell A5) and paste the data that meets criteria and is non-blank in column C (starting at C5). I also want column C to be continuous data, so it'll post the next value after the last nonblank cell in the column.

IF criteria: cell value starts with "AA" or "BA"

And then I'd like the sub to start once it reaches a cell with value "Stop"

So column A would go somewhat like this:

AA1 (A5)
*blank*
AA2
BA3
Random values
BA4
Stop

Results, starting in C5:
AA1
AA2
BA3
BA4

This is what I have so far, which gets the values but based on criteria but doesn't consolidate rows when pasting:

VBA Code: 
Sub Help_Plz ()
Dim i As Long
For i = 5 To 50 'Ideally i'd like this to expand to the last row, or "Stop"
If Left(Range("A" & i), 2) = "AA"
Or Left(Range("A" & i), 2) = "BA" Then
Range ("A" & i).Copy
Range ("C" & i).PasteSpecial xlPasteValues
Else: GoTo Skip
End If

Skip:
Next i
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Try this:

VBA Code: 
Sub LoopAndSkipBlanks()

Dim i As Long

y = 5

For i = 5 To 50 'Ideally i'd like this to expand to the last row, or "Stop"

If Left(Range("A" & i), 4) = "Stop" Then
    Exit Sub
Else
    If Left(Range("A" & i), 2) = "AA" Or Left(Range("A" & i), 2) = "BA" Then
        
        Range("A" & i).Copy
        Range("C" & y).PasteSpecial xlPasteValues
        y = y + 1
    Else: GoTo Skip
    
    End If
    
End If

Skip:
Next i

End Sub

That should get you where you want to go. Let me know if you run into any errors.
 
Upvote 0
Solution
Filter Column With Loop

VBA Code: 
Option Explicit

Sub filterColumnWithLoop()
   
    ' Define constants.
   
    Const FirstRow As Long = 5 ' First Row Number (Both Columns)
    Const srcCol As Long = 1   ' Source Column Number
    Const tgtCol As Long = 3   ' Target Column Number
   
    ' Prepare Target Column.
   
    ' Determine Target Last Row ('tLastRow').
    Dim tLastRow As Long
    tLastRow = Cells(Rows.Count, tgtCol).End(xlUp).Row
    ' Clear previous results in Target Column Range.
    If tLastRow >= FirstRow Then
        Cells(FirstRow, tgtCol).Resize(tLastRow - FirstRow + 1).ClearContents
    End If
        
    ' Prepare Source Column
   
    ' Determine Source Last Row ('sLastRow').
    Dim sLastRow As Long
    sLastRow = Cells(Rows.Count, srcCol).End(xlUp).Row
    ' Validate Source Last Row. If it is less than First Row there is no data.
    If sLastRow < FirstRow Then
        Exit Sub
    End If
   
    ' Prepare for the loop. Declare additional variables.
   
    ' Determine Target Current Row ('tRow').
    Dim tRow As Long
    tRow = FirstRow - 1

    Dim CurrentValue As Variant ' Source Current Value
    Dim i As Long ' Source Current Row
   
    ' Write values from Source Column to Target Column.
   
    ' Iterate (loop through) rows of Source Column (Range).
    For i = FirstRow To sLastRow
        ' Write value from current cell in Source Column to Current Value.
        CurrentValue = Cells(i, srcCol).Value
        ' Check if Current Value can be converted to a string.
        If VarType(CurrentValue) = vbString Then
            ' Check the left two characters of Current Value...
            Select Case Left(CurrentValue, 2)
                ' ... against the two-character Criteria Strings.
                Case "AA", "AB"
                    ' Determine Target Current Row.
                    tRow = tRow + 1
                    ' Write value from Current Source Cell (Range)
                    ' to Current Target Cell Range.
                    Cells(tRow, tgtCol).Value = Cells(i, srcCol).Value
                Case Else
                ' Do nothing if <> 'AA' and 'AB'.
            End Select
        End If
    Next i
    
    ' Inform user.
    
    MsgBox "Data copied.", vbInformation, "Success"

End Sub
 
Upvote 0
VBasic2008 said:
Filter Column With Loop

VBA Code: 
Option Explicit

Sub filterColumnWithLoop()
  
    ' Define constants.
  
    Const FirstRow As Long = 5 ' First Row Number (Both Columns)
    Const srcCol As Long = 1   ' Source Column Number
    Const tgtCol As Long = 3   ' Target Column Number
  
    ' Prepare Target Column.
  
    ' Determine Target Last Row ('tLastRow').
    Dim tLastRow As Long
    tLastRow = Cells(Rows.Count, tgtCol).End(xlUp).Row
    ' Clear previous results in Target Column Range.
    If tLastRow >= FirstRow Then
        Cells(FirstRow, tgtCol).Resize(tLastRow - FirstRow + 1).ClearContents
    End If
       
    ' Prepare Source Column
  
    ' Determine Source Last Row ('sLastRow').
    Dim sLastRow As Long
    sLastRow = Cells(Rows.Count, srcCol).End(xlUp).Row
    ' Validate Source Last Row. If it is less than First Row there is no data.
    If sLastRow < FirstRow Then
        Exit Sub
    End If
  
    ' Prepare for the loop. Declare additional variables.
  
    ' Determine Target Current Row ('tRow').
    Dim tRow As Long
    tRow = FirstRow - 1

    Dim CurrentValue As Variant ' Source Current Value
    Dim i As Long ' Source Current Row
  
    ' Write values from Source Column to Target Column.
  
    ' Iterate (loop through) rows of Source Column (Range).
    For i = FirstRow To sLastRow
        ' Write value from current cell in Source Column to Current Value.
        CurrentValue = Cells(i, srcCol).Value
        ' Check if Current Value can be converted to a string.
        If VarType(CurrentValue) = vbString Then
            ' Check the left two characters of Current Value...
            Select Case Left(CurrentValue, 2)
                ' ... against the two-character Criteria Strings.
                Case "AA", "AB"
                    ' Determine Target Current Row.
                    tRow = tRow + 1
                    ' Write value from Current Source Cell (Range)
                    ' to Current Target Cell Range.
                    Cells(tRow, tgtCol).Value = Cells(i, srcCol).Value
                Case Else
                ' Do nothing if <> 'AA' and 'AB'.
            End Select
        End If
    Next i
   
    ' Inform user.
   
    MsgBox "Data copied.", vbInformation, "Success"

End Sub
Click to expand...
I forgot about "Stop":

VBA Code: 
Option Explicit

Sub filterColumnWithLoop()
    
    ' Define constants.
    
    Const FirstRow As Long = 5 ' First Row Number (Both Columns)
    Const srcCol As Long = 1   ' Source Column Number
    Const tgtCol As Long = 3   ' Target Column Number
    
    ' Prepare Target Column.
    
    ' Determine Target Last Row ('tLastRow').
    Dim tLastRow As Long
    tLastRow = Cells(Rows.Count, tgtCol).End(xlUp).Row
    ' Clear previous results in Target Column Range.
    If tLastRow >= FirstRow Then
        Cells(FirstRow, tgtCol).Resize(tLastRow - FirstRow + 1).ClearContents
    End If
         
    ' Prepare Source Column
    
    ' Determine Source Last Row ('sLastRow').
    Dim sLastRow As Long
    sLastRow = Cells(Rows.Count, srcCol).End(xlUp).Row
    ' Validate Source Last Row. If it is less than First Row there is no data.
    If sLastRow < FirstRow Then
        Exit Sub
    End If
    
    ' Prepare for the loop. Declare additional variables.
    
    Dim CurrentValue As Variant ' Source Current Value
    ' Determine Target Current Row ('tRow').
    Dim tRow As Long
    tRow = FirstRow - 1
    Dim i As Long ' Source Current Row
    
    ' Write values from Source Column to Target Column.
    
    ' Iterate (loop through) rows of Source Column (Range).
    For i = FirstRow To sLastRow
        ' Write value from current cell in Source Column to Current Value.
        CurrentValue = Cells(i, srcCol).Value
        ' Check if Current Value can be converted to a string.
        If VarType(CurrentValue) = vbString Then
            ' Check if Current Value is equal to "Stop".
            If CurrentValue = "Stop" Then
                ' Exit the loop. The code continues after 'Next i'.
                Exit For
            End If
            ' Check the left two characters of Current Value...
            Select Case Left(CurrentValue, 2)
                ' ... against the two-character Criteria Strings.
                Case "AA", "AB"
                    ' Determine Target Current Row.
                    tRow = tRow + 1
                    ' Write value from Current Source Cell (Range)
                    ' to Current Target Cell Range.
                    Cells(tRow, tgtCol).Value = Cells(i, srcCol).Value
                Case Else
                ' Do nothing if <> 'AA' and 'AB'.
            End Select
        End If
    Next i
     
    ' Inform user.
     
    MsgBox "Data copied.", vbInformation, "Success"

End Sub
 
Upvote 0
ekrause said:
Try this:

VBA Code: 
Sub LoopAndSkipBlanks()

Dim i As Long

y = 5

For i = 5 To 50 'Ideally i'd like this to expand to the last row, or "Stop"

If Left(Range("A" & i), 4) = "Stop" Then
    Exit Sub
Else
    If Left(Range("A" & i), 2) = "AA" Or Left(Range("A" & i), 2) = "BA" Then
       
        Range("A" & i).Copy
        Range("C" & y).PasteSpecial xlPasteValues
        y = y + 1
    Else: GoTo Skip
   
    End If
   
End If

Skip:
Next i

End Sub

That should get you where you want to go. Let me know if you run into any errors.
Click to expand...
Thanks! This was exactly what I needed
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Multiple columns into 2?
Replies
6
Views
96
Georgiboy
Georgiboy
R
  • Question
Macro to copy and paste into table skipping blank cells
Replies
1
Views
153
roboco
R
M
  • Question
Excel formula to skip a cell, multiple conditions
2
Replies
11
Views
391
Fluff
Fluff
C
  • Solved
For Next loop skipping blank cell, but indexes past next cell
Replies
7
Views
192
NoSparks
N
theYaniac
  • Solved
I would like to insert a blank row between each new unique identifier in column A.
Replies
3
Views
166
MARK858
MARK858

Forum statistics

Threads
1,214,827
Messages
6,121,817
Members
449,049
Latest member
cybersurfer5000

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top