Solved: If value not found go to next cell

[kathyb0527]

Hi everyone, I have data that comes out of our database concatenated that our client wants presented in 2 columns. The problem is that not all of the data is separated into the two columns, and there is a lot of extraneous text that needs to be deleted. I've written code to pull out the lines that need to be separated and used text to colums to get the text into two columns, but I'm stuck as to how to get the two columns back into the original spreadsheet. Here is the code I have so far:
[vba]Sub correcttimepoint()
Dim SampName As Range
Dim Cell As Variant
Dim sh_Source As Worksheet
Dim sh_Dest As Worksheet, wks As Worksheet
Dim NextrowD As Variant
Dim LastCell As Range

Set sh_Dest = ActiveWorkbook.Worksheets(3)
Set sh_Source = ActiveWorkbook.Worksheets(1)
Set SampName = Worksheets(1).Range("C:C").SpecialCells(xlCellTypeConstants)

Application.ScreenUpdating = False

NextrowD = sh_Dest.Range("A" & Rows.Count).End(xlUp).Row
For Each Cell In SampName
If InStr(Cell.Value, "PLM") <> 0 Then
NextrowD = NextrowD + 1
With sh_Source
.Range("B" & Cell.Row).Copy
sh_Dest.Range("A" & NextrowD).PasteSpecial (xlPasteValues)
.Range("C" & Cell.Row).Copy
sh_Dest.Range("B" & NextrowD).PasteSpecial (xlPasteValues)
End With
End If
Next Cell
sh_Dest.Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon _
:=False, Comma:=False, Space:=True, Other:=True, OtherChar:="/", _
FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 1), Array _
(6, 1), Array(7, 1), Array(8, 1), Array(9, 9), Array(10, 9), Array(11, 9), Array(12, 9), _
Array(13, 9), Array(14, 9)), TrailingMinusNumbers:=True
Set LastCell = Range("A65536").End(xlUp).Offset(0, 6)
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-4]&"" ""&RC[-3]&"" ""&RC[-2]&RC[-1]"
Selection.AutoFill Destination:=Range("G2", LastCell), Type:=xlFillDefault
sh_Source.Activate
Columns("D").Select
Selection.Insert Shift:=xlToRight
Application.ScreenUpdating = True

End Sub[/vba]

Two other issues I am having. One is that the data starts pasting in row 2 and I'm not sure why. The other is that at times, the code stops at sh_dest.range("B2").select with the message "select method of range class failed". Do I need to activate the worksheet?

I've also attached the spreadsheet.

Thank you in advance for your help.

Kathyb0527

[JimmyTheHand]

I'm stuck as to how to get the two columns back into the original spreadsheet

That depends on where you want to put them. Replace the original Sample Name with Column1 and put Column2 next to it? Or retain the original data and insert 2 new columns? And what about the unneeded rows? (I.e. the ones that don't have "PLM" substring.) Should they be deleted, perhaps?

Can you post a sample workbook with the desired output included?

the data starts pasting in row 2 and I'm not sure why

Look at the code:
[vba]NextrowD = sh_Dest.Range("A" & Rows.Count).End(xlUp).Row
For Each Cell In SampName
If InStr(Cell.Value, "PLM") <> 0 Then
NextrowD = NextrowD + 1 [/vba] Result of line #1 of the code above (in case of an empty sh_Dest sheet) is: NextrowD = 1
Then, right at the beginning of the loop (line #4) NextrowD is increased by 1. So when NextrowD is used for the first time, its value will be 2.

at times, the code stops at sh_dest.range("B2").select with the message "select method of range class failed". Do I need to activate the worksheet?

Activating the worksheet would solve the problem, but it's best if you don't select the range at all. In most cases you don't need to select ranges. In general, you can contract the code parts before Select and after Selection. For example
[vba]Range(SomeRange).Select
Selection.DoSomething [/vba] can be contracted to
[vba] Range(SomeRange).DoSomething[/vba]
Jimmy

[kathyb0527]

Jimmy,
Thank you for the great explanation for the nextrowD. I'm learning on my own, so I tend to modify a lot of code already written and miss some concepts.

Activating the worksheet would solve the problem, but it's best if you don't select the range at all. In most cases you don't need to select ranges. In general, you can contract the code parts before Select and after Selection.

I have been trying not to select everything, but I'm not sure how to do that with data where the number of rows or columns change, so I use .end(xldown) and I'm not sure how it works if you don't select.

I've attached a copy of what the final spreadsheet should look like. I was inspired this morning to use vlookup to move the data back to the original worksheet, but again, I'm stumped as to how to use this code when the number of lines varies.
[vba]Sub movingdata()
Dim Cell As Range
Dim SeqNum As Range
Dim SampNameOrig As Range, SampName As Range
Dim TimePTOrign As Range

Set SeqNum = Sheets(1).Range("A2", Selection.End(xlDown))
Set SampNameOrig = Sheets(1).Range("C3", Selection.End(xlDown))

For Each Cell In SampNameOrig
If InStr(Cell.Value, "PLM") <> 0 Then
Cell.Value = Application.WorksheetFunction.VLookup(Cell.Offset(0, -1), _
Sheets(3).Range("A2:G69"), 2, False)
Cell.Offset(0, 1).Value = Application.WorksheetFunction. _
VLookup(Cell.Offset(0, -1), Sheets(3).Range("A2:G69"), 7, False)
End If
Next Cell


End Sub
[/vba]

I guess I should mention that this is just a part of a larger project that takes sheets 1 and 2 and combines it. I have that part done though.

Thank you so much for your help,
Kathyb0527

[Simon Lloyd]

These lines:
[vba]Set SeqNum = Sheets(1).Range("A2", Selection.End(xlDown))
Set SampNameOrig = Sheets(1).Range("C3", Selection.End(xlDown))
[/vba]would probably be better like this to save selecting![vba]Set SeqNum = Sheets(1).Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
Set SampNameOrig = Sheets(1).Range("C3:C" & Range("C" & Rows.Count).End(xlUp).Row)[/vba]
for your Vlookup you could use:
[VBA]
VLookup(Cell.Offset(0, -1), Sheets(3).Range("A2:G" & Range("G" & Rows.Count).End(xlUp).Row) , 7, False)

[/VBA]

[JimmyTheHand]

There are a number of possible ways to go. What Simon suggested lies along your original path, using Vlookup. I think that solves your problem, but my understanding was that you wanted to learn, so I propose another solution, with a different approach. The main concept in steps:

(Note: in the following description I will refer to the samples with "PLM" substring as "Type 1" samples, and to all the rest, including standard, blank and quality control ones, as "Type 2" samples.)

1) Copy the whole range of sample names to another sheet for further processing. By "whole range" I mean all samples, including Type 1 and Type 2 ones.
2) In the copied range, clear the Type 2 sample names. Unlike when listing Type 1 samples in a contiguous range, this way they retain their original, relative positions, so when the "Text to Columns" and other operations are done, and we want to copy the results back to Sheet1, we don't need to search for where they would go, cell by cell. We just need to copy/paste the whole range in one step.
3) Over the working range, split the text to columns the way you did.
4) Insert a column right after the sample names, and put the concatenating formula there. This way the two important colums (i.e. stripped sample names and Day/Hour data) go next to each other. This results in a contiguous range, which is easier to handle than when they are separated into two non-adjacent columns.
5) Copy/Paste the values. The paste operation goes with the PasteSpecial method, because it allows skipping blank cells by setting the flag SkipBlanks to True. So Type 2 samples remain untouched in Sheet1, only Type 1 samples are updated.

Here's the code.
[vba]Sub correcttimepoint_2()
Dim SampName As Range, WorkRange As Range, Cel As Range
Dim sh_Source As Worksheet, sh_Dest As Worksheet

Set sh_Dest = ActiveWorkbook.Worksheets("Sheet 3")
Set sh_Source = ActiveWorkbook.Worksheets("Sheet1")
Set SampName = sh_Source.Range("C:C").SpecialCells(xlCellTypeConstants)

SampName.Offset(, 1).EntireColumn.Insert
sh_Dest.Cells.Delete
'Step 1)
SampName.Copy sh_Dest.Range("A1")
Set WorkRange = sh_Dest.Range("A:A").SpecialCells(xlCellTypeConstants)
'Step 2)
For Each Cel In WorkRange
If InStr(Cel.Value, "PLM") = 0 Then Cel.ClearContents
Next
With WorkRange
'Step 3)
.TextToColumns Destination:=WorkRange(1), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=True, OtherChar:="/", _
FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 1), Array _
(6, 1), Array(7, 1), Array(8, 1), Array(9, 9), Array(10, 9), Array(11, 9), Array(12, 9), _
Array(13, 9), Array(14, 9)), TrailingMinusNumbers:=True
'Step 4)
.Offset(, 1).EntireColumn.Insert
.Offset(, 1).FormulaR1C1 = "=RC[1]&"" ""&RC[2]&"" ""&RC[3]&RC[4]"
'Step 5)
.Resize(, 2).Copy
Application.DisplayAlerts = False
SampName.Resize(2).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
Application.DisplayAlerts = True
End With
SampName.Resize(, 2).EntireColumn.AutoFit
End Sub
[/vba]
Jimmy

[kathyb0527]

Thank you both! Simon, I've been struggling with that for a while now, and seeing my code modified made it click! Jimmy, Thanks for going the extra distance and teaching me. I am the only one in my company that even knows what a macro is so there is no one for me to learn from except trial and error. I really appreciate the help. I'm marking this solved, but I'll be back!

Kathyb