VBA, All my data is in a single column. How do I scan and grab all the relevant info?

Question

My Data : https://i.stack.imgur.com/omL9f.jpg

My code so far:

Sub Leads()

ActiveSheet.Range("J:J").Select

For i = 1 To 100

ActiveCell.Offset(1, 0).Select

If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1")

Next i

End Sub

I want to scroll down J column and everytime the value "Another Car" and a portion of "Mikes Auto Shop" springs up I want to copy and paste the row RIGHT under it into the "L,M, and O" column within the same row.

Just like this https://i.stack.imgur.com/HdJR7.jpg but would cycle through hundreds of lines of code

Really really appreciate the help everyone, thanks!

Do you need VBA? Wouldn't a formula work? In `L2`, for instance you could try `=IF(OR($J1="Another Car",$J1="Mikes Auto Shop"),$J1,"")` and drag down, and copy/paste into col M and O as well. You'll also want to use `Mid()` with `Search()` to break up the data. — BruceWayne, Mar 27 '17 at 19:03
Welcome to SO. You're question is a bit unclear, since the description of what you want and your pictures *do not match*. Also, your code attempt is pretty far from your final requirements, but you have not asked a *specific question*. Write now, this is "please build my code for me, question", which will likely illicit little response. Read [How to Ask](http://stackoverflow.com/help/how-to-ask) for more. — Scott Holtzman, Mar 27 '17 at 19:05

Jared · Accepted Answer · 2017-03-27T20:46:01.437

This will work given a few assumptions, like, there's no apostrophe in Mikes Auto Shop and that the first space in the car model is the correct place to split the data.

Option Compare Text
Sub test()

Dim DataRange As Range
Dim LastRow As Integer
Dim i As Integer
Dim SplitVal() As String

LastRow = Cells(Rows.Count, "J").End(xlUp).Row

For i = 1 To LastRow
  If ActiveSheet.Cells(i, 10).Value = "Another Car" Then
    If InStr(1, Cells(i + 3, 10).Value, "Mikes Auto Shop", vbTextCompare) <> 0 Then
      SplitVal = Split(Cells(i + 1, 10).Value, " ", 2)
      Cells(i + 1, 12).Value = SplitVal(0)
      Cells(i + 1, 13).Value = SplitVal(1)
      Cells(i + 1, 15).Value = Cells(i + 4, 10).Value
    End If
  End If
Next i


End Sub

Edit as per comment request. I'm not sure where you want the output, you can adjust OutputOffset, Mikes Auto Shop row is 0, -1 is up, +1 is down.

Sub test()

Dim DataRange As Range
Dim LastRow As Integer
Dim i As Integer
Dim SplitVal() As String
Dim OutputOffset As Long
OutputOffset = 0

LastRow = Cells(Rows.Count, "J").End(xlUp).Row

For i = 2 To LastRow
    If InStr(1, Cells(i, 10).Value, "Mikes Auto Shop", vbTextCompare) <> 0 Then
      SplitVal = Split(Cells(i - 1, 10).Value, " ", 2)
      Cells(i + OutputOffset, 12).Value = SplitVal(0)
      Cells(i + OutputOffset, 13).Value = SplitVal(1)
      Cells(i + OutputOffset, 15).Value = Cells(i + 1, 10).Value
    End If
Next i


End Sub

You're a LIFESAVER!!! Thank you so much! One quick question, is there any way to change the code so instead of searching for Another Car it uses Whats ABOVE "Mikes Auto Shop"? So it would grab whats above it and whats below it? — user3663068, Mar 27 '17 at 20:27
Again, a lifesaver. Plus it's actually kindof fun learning VBA since I know a little bit of logic, ill def continue this journey :) — user3663068, Mar 27 '17 at 20:55
Just accepted the answer, sorry for delay! It wont let me upvote because im new though. — user3663068, Mar 28 '17 at 05:13

score 0 · Answer 2 · edited May 23 '17 at 12:09

Let's start from your code:

Sub Leads()

    ActiveSheet.Range("J:J").Select

    For i = 1 To 100

        ActiveCell.Offset(1, 0).Select

        If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1")

    Next i

End Sub

What I would do:

Get rid of ActiveSheet.Range("J:J").Select as it might be slow to work with selection

Note: For i = 1 To 100 will take the rows from 1 to 100. You might want to actually use a dynamic method to check that number. You can check the following: https://stackoverflow.com/a/11169920/2012740.

If you get rid of the selection, remove also the ActiveCell.Offset(1, 0).Select

If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1") will become:

If Cells(i,10).Value = "Another Car" Then 'This condition is the same as before

  SplitedValue = Split(Cells(i+1,10).Value," ") ' With this code you will split the value from the first row below the row which contains "Another Car" text. The value is splitted by " " (empty space). For more references and parameters you can read about the other parameters of `split` function

  Cells(i+1,12).Value = SplitedValue(0) 'This will add the first part of the splitted string in the cell which is one row below the current row, and on column 12 (L)

  Cells(i+1,13).Value = SplitedValue(1) 'This will add the second part of the splitted string in the cell which is one row below the current row, and on column 13 (M)

  Cells(i+1,15).Value = Cells(i+4,10).Value ' This will add the value from the cell which is located 4 rows below the current cell, to the cell which is located one row below the current row and on column 15 (O)

EndIf 'Close the if statement here

Remember to declare dim SplitedValue as Variant

Thank you so much, I appreciate the effort :) – user3663068 Mar 27 '17 at 20:54 — user3663068, Mar 27 '17 at 20:54

VBA, All my data is in a single column. How do I scan and grab all the relevant info?

2 Answers2