Change code when a blank cell reached

**russwongg** · 08-26-2014, 05:28 AM

Hi,

I have written a data extraction code here. The Cells.Find value will be taken from Cell A2, A3, A4... down. I have put "For x = 2 to 88" but data set is not 88 rows long and i do not wish to change it everytime i change row numbers. What i want to do, is that when a blank cell (Ax) is reached, i want the code to jump to the Red colored code. How would i do this? I've tried If FindValue = "" GoTo ... but i keep getting errors

Thanks!

p.s. this is my first time writing such a long code and I've learnt this for a week so it'll probably look messy and junky to you.

 Sub DataExtraction()
Sheets("Sheet2").Select
Range("A1").Activate
For x = 2 To 88
    FindValue = Sheets("Sheet3").Cells(x, 1).Value
    Sheets("Sheet2").Select
    Cells.Find(What:=FindValue, after:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(0, -3).Select
        If IsEmpty(ActiveCell) Then
        Cells.FindNext(after:=ActiveCell).Activate
        Cells.FindNext(after:=ActiveCell).Activate
        ActiveCell.Offset(0, -3).Select
        Selection.Copy
        ActiveSheet.Next.Select
        Cells(x, 2).Select
        ActiveSheet.Paste
        Else
        Cells.FindNext(after:=ActiveCell).Activate
        Cells.FindNext(after:=ActiveCell).Activate
        ActiveCell.Offset(0, -3).Select
        Selection.Copy
        ActiveSheet.Next.Select
        Cells(x, 2).Select
        ActiveSheet.Paste
   End If
Next x

Sheets("sheet2").Select
Range("A1").Activate
For x = 2 To 88
    FindValue = Sheets("sheet3").Cells(x, 1).Value
    Sheets("sheet2").Select
    Cells.Find(What:=FindValue, after:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 15).Select
    If IsEmpty(ActiveCell) Then
    Cells.FindNext(after:=ActiveCell).Activate
    ActiveCell.Offset(0, 15).Select
    Selection.Copy
    ActiveSheet.Next.Select
    Cells(x, 3).Select
    ActiveSheet.Paste
    Else
    Selection.Copy
    ActiveSheet.Next.Select
    Cells(x, 3).Select
    ActiveSheet.Paste
    End If

Next x

End Sub

**stnkynts** · 08-26-2014, 11:39 AM

There are many, many, ways you can approach this problem. I think the solution that might make the most sense to you would be to do something like this. I can't really understand the big picture so hopefully this will put you on the right track.

Sub Example()
Dim ws2 As Worksheet:   Set ws2 = Sheets("Sheet2")
Dim ws3 As Worksheet:   Set ws3 = Sheets("Sheet3")
Dim FindValue As String
Dim bEmpty As Boolean
Dim x As Integer

bEmpty = False 'you are going to use this as a check to change the code within the loop once an empty cell comes up

For x = 2 To 88
    FindValue = ws3.Cells(x, 1).Value
    If FindValue = "" Then
        bEmpty = True
    End If
    
    If FindValue = False Then
        'this is where the first half of your code would go
    ElseIf FindValue = True Then
        'this is where the second half of your code would go.  The code that you need applied after you hit the first blank cell
    End If
Next x
    
End Sub

**russwongg** · 08-26-2014, 11:38 PM

I understand what's going on here. It's an interesting way of tackling the problem. Is there a way to edit the code such that once bEmpty = True and jumps to the second half of the code x restarts to 2 again?

Sub DataExtraction()
Dim FindValue As String
Dim bEmpty As Boolean
Dim x As Integer

bEmpty = False 'use to when to change code within loop when empty cell reached

Sheets("sheet2").Activate
        Range("A1").Activate
For x = 2 To 88
    FindValue = Sheets("sheet3").Cells(x, 1).Value
    If FindValue = "" Then
        bEmpty = True
    End If
        Sheets("sheet2").Activate
        If bEmpty = False Then 'Search first column
        Cells.Find(What:=FindValue, after:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
            ActiveCell.Offset(0, -3).Select
            If IsEmpty(ActiveCell) Then
            Cells.FindNext(after:=ActiveCell).Activate
            Cells.FindNext(after:=ActiveCell).Activate
            ActiveCell.Offset(0, -3).Select
            Selection.Copy
            ActiveSheet.Next.Select
            Cells(x, 2).Select
            ActiveSheet.Paste
            Else
            Cells.FindNext(after:=ActiveCell).Activate
            Cells.FindNext(after:=ActiveCell).Activate
            ActiveCell.Offset(0, -3).Select
            Selection.Copy
            ActiveSheet.Next.Select
            Cells(x, 2).Select
            ActiveSheet.Paste
       End If

    ElseIf bEmpty = True Then
        Sheets("sheet2").Select
        FindValue = Sheets("sheet3").Cells(x, 1).Value
        Cells.Find(What:=FindValue, after:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(0, 15).Select
        If IsEmpty(ActiveCell) Then
        Cells.FindNext(after:=ActiveCell).Activate
        ActiveCell.Offset(0, 15).Select
        Selection.Copy
        ActiveSheet.Next.Select
        Cells(x, 3).Select
        ActiveSheet.Paste
        Else
        Selection.Copy
        ActiveSheet.Next.Select
        Cells(x, 3).Select
        ActiveSheet.Paste
        End If
    End If
Next x

End Sub

**stnkynts** · 08-27-2014, 10:31 AM

Yeah its possible but I can't understand why you would want to do that. I am afraid to assist you further because I really have no idea what you are trying to do and I don't want to confuse things. Maybe if you submit an example workbook which clearly shows a before and after product I can write the code to do that.

Change code when a blank cell reached

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Change code when a blank cell reached

Re: Change code when a blank cell reached

Re: Change code when a blank cell reached

Re: Change code when a blank cell reached

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Counting number of 1s in a row until blank cell is reached.

Show A1 in C3, then A2 in C3, then A3 in C3 until blank cell reached on button press

Stopping A Loop When A Blank Cell Is Reached

Autofill until blank cell is reached

Autofill until blank cell is reached

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions