Search One Column of Worksheet for multiple different partial texts, and if found post a respective value in the same row, one column further

[karp1]

Hi Everyone! I am a beginner to macros and just received help on another question here. I would like to adjust the code however, and have been struggling a lot. I just wrote a macro which compiles data from different workbooks into one compiled data workbook. This compiled data is structured as follows:

Item Name	Measured Value	Source File Name
A	X	Patient1.xls
B	X	Patient1.xls
C	X	Patient1.xls
A	X	Patient2.xls
B	X	Patient2.xls
C	X	Patient2.xls
A	X	Patient3.xls

Thanks again to Fluff for helping me get to this point!

I would now like to look at the column "Source File Name" and find multiple partial texts. If this partial text is found, I would like it to post text in Column D with a respective text. For example, I would want it to look through and find file names containing Patient1, Patient3, Patient7, and Patient5. If any one of these is present I would like the program to print "Control" in column D. However, if the program finds file names containing Patient2 or Patient4 it should print "Test". And if the program finds file names Patient6 or Patient8 it should print "Placebo".

The code I have for the compiling of the workbooks into one is as follows:

Sub DataTransposingMrExcel()
Dim strP As String, strF As String
Dim Wbk As Workbook
Dim Ws As Worksheet

strP = "Z:\User\Macro\DataFolder" 'Location of your data which has been put into the template
strF = Dir(strP & "\*.xls")

If strF <> "" Then
Set Wbk = Workbooks.Open("Z:\User\Macro\CompiledData.xlsx")
Set Ws = Wbk.Sheets("Sheet1")
End If

Do While strF <> vbNullString
Workbooks.Open (strP & "\" & strF)
Sheets("Sheet1").Range("L1:CZ1").Copy
Ws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues, , , True
Sheets("Sheet1").Range("L3:CZ3").Copy
With Ws.Range("B" & Rows.Count).End(xlUp)
.Offset(1).PasteSpecial xlPasteValues, , , True
.Offset(1, 1).Resize(94).Value = strF

End With
ActiveWorkbook.Close False
strF = Dir()
Loop
Wbk.Close True
End Sub


I have tried to perform the serach for partial text in various different ways but none have gotten very far. Due to the fact that I am a relative beginner, I have a lot of small scale problems that won't let me define the range or open the workbook. I therefore haven't gotten very far. I'm not sure how much it would help to post the code that I have tried.

I guess from my reading I am leaning towards taking doing an If, Then loop, maybe something like

If Wbk.Open("C").Cell.Value("Patient1" Or "Patient3" Or "Patient5")
Then Cell.Offset(0, 1).Value = "Control"
If Wbk.Open("C").Cell.Value("Patient2" Or "Patient4")
Then Cell.Offset(0, 1).Value = "Test"
If Wbk.Open("C").Cell.Value("Patient6" Or "Patient8")
Then Cell.Offset(0, 1).Value = "Placebo"
End If



I would be very grateful for your help in this matter!

 

[karp1]

Hi guys, just following up on my question. I've decided that I can only do this within the compiled data sheet, and was not able to build the code into the original code that compiles the data. I wrote the following code but it has not been working. I get the error Application-defined or Object-defined error at the first If line. I have tried several remedies. I have replaced ActiveSheet.Range with Sheet1.Range, Application.Range, and ws.Range. All of these options resulted in similar error messages. I am sure I am missing a small aspect which allows me to define the Range correctly for the program but I am stumped. Again: My goal is to search the cells in column "C" of Sheet1 on CompiledData.xlsx for the partial text. There are four categories I would like to define/look for. See the question above for more context. Hoping someone can help me out!

Sub ConditionAdding()


   Dim Wbk As Workbook
   Dim ws As Worksheet

Workbooks.Open Filename:= _
        "F:\KATI 2_LC\MacroStuff\CompiledData.xlsx"
       
Sheets("Sheet1").Activate
       
If ActiveSheet.Range("C").Value = "P1" Or ActiveSheet.Range("C").Value = "P3" Or ActiveSheet.Range("C").Value = "P5" Or ActiveSheet.Range("C").Value = "P6" Or ActiveSheet.Range("C").Value = "P8" Or ActiveSheet.Range("C").Value = "P7" Or ActiveSheet.Range("C").Value = "P96" Or ActiveSheet.Range("C").Value = "P104" Or ActiveSheet.Range("C").Value = "P68" Or ActiveSheet.Range("C").Value = "P23" Or ActiveSheet.Range("C").Value = "P11" Then
   ActiveSheet.Range("D").Offset(0, 1).Value = "Test"
ElseIf ActiveSheet.Range("C").Value = "P13" Or ActiveSheet.Range("C").Value = "P17" Or ActiveSheet.Range("C").Value = "P30" Or ActiveSheet.Range("C").Value = "P10" Or ActiveSheet.Range("C").Value = "P12" Or ActiveSheet.Range("C").Value = "P9" Then
    ActiveSheet.Range("D").Offset(0, 1).Value = "Control"
ElseIf ActiveSheet.Range("C").Value = "P41" Or ActiveSheet.Range("C").Value = "P238" Or ActiveSheet.Range("C").Value = "P501" Or ActiveSheet.Range("C").Value = "P24" Then
    ActiveSheet.Range("D").Offset(0, 1).Value = "Placebo"
ElseIf ActiveSheet.Range("C").Value = "P2" Or ActiveSheet.Range("C").Value = "P4" Or ActiveSheet.Range("C").Value = "P674" 
    ActiveSheet.Range("D").Offset(0, 1).Value = "Control2"
End If

End Sub