If then else macro

[Brundles]

Hi all,

I am new to the site and am looking for some wisdom to create a macro.

Data is imported to sheet 1 via a macro. I am working on another macro that will organize the imported data and move it to sheets 2 and 3. The imported data is three columns. Column A has data that is a combination of letters and numbers. Columns B and C are only numerical. All three columns will always be the same number of rows, but depending on what data is imported, the number of rows can vary.

The macro should look through the cells in column A and identify if it contains a specific word (case insensitive). If it does, then the macro will copy the cell in column A and the corresponding cell in column B and paste it in sheet2. If it does not, the cell in column A and the corresponding cell in column C is copied and pasted into sheet3.

Example:

Name	value1	value2
Animalcat1	1	6
animaldog1	2	7
animalCAT2	3	8
animalDog2	4	9
animalCat3	5	10

<TBODY>
</TBODY>

Setting the search word as cat (again, case insensitive), the macro should result with:


Sheet2:

Name	Value1
Animalcat1	1
animalCAT2	3
animalCat3	5

<TBODY>
</TBODY>

Sheet3:

Name	Value2
animaldog1	7
animalDog2	9

<TBODY>
</TBODY>

Additional Notes: This information will be updated daily with new data so when the macro sorts the imported data to sheets 2 and 3, it will begin where the previous data ended.

I have some code that, so far, successfully imports to only one of the sheets, but will overwrite if I try to execute it again. This code is the result of digging through various forums looking for questions similar to mine. I am using an array, but thought perhaps some sort of if...then...else statement might be more appropriate. Also, I have to add combinations of upper and lower case letters for "cat" in this code, but would rather have a line that would designate case insensitive.

Sub SORT()
Dim cell As Range
Dim rngDest As Range
Dim i As Long
Dim arrColsToCopy
    arrColsToCopy = Array(1, 2)
    
    Set rngDest = Worksheets("sheet2").Range("A3")
    Application.ScreenUpdating = False
    For Each cell In Worksheets("sheet1").Range("A6:A1000").Cells
        If cell Like "*CAT*" Or _
        cell Like "*cat*" Or _
        cell Like "*Cat*" Then
            For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                With cell.EntireRow
                    .Cells(arrColsToCopy(i)).Copy rngDest.Offset(0, i)
                End With
            Next i
            Set rngDest = rngDest.Offset(1, 0) 'next destination row
        End If
    Next cell
    Application.ScreenUpdating = True
End Sub

Any help would be greatly appreciated!!

 

[mikerickson]

Have you looked at Advanced Filter, using wildcards in the criteria?

 

[Brundles]

Have you looked at Advanced Filter, using wildcards in the criteria?

Thank you for such a quick reponse, mikerickson! You have helped me immensely in focusing my search! This should keep me busy for a while. I am fairly confident that the answer is already here, I just have to find it! I will update should I run into any problems. Thanks again!

 

[Brundles]

Update:

I was able to rectify the issue with case sensitivity. I simply added

Option Compare Text

at the very beginning and it worked like a charm. Thanks, mikerickson for pointing me in the right direction.

There are some other things I would like to add to my code, but need some additional guidance. My programming vocabulary is limited so even keyword suggestions would really help me out.

I am having three issues with my current code. The first is that for some reason when it sends data to sheets 2 and 3, it starts at row 25. I don't know why it does that or what I can do to fix it.

The second problem is that when the data is moved to sheets 2 and 3, I want it to begin where the last data ended. For example, if there is already data in the first 45 rows in sheet 2, then next set of data that is moved there will begin at 46. Right now, it overwrites the previous data.

The last problem is that I only want one of the columns (B or C) in each sheet. Right now, the macro separates the data by name ("cat"), but puts both columns B and C in sheets 2 and 3. I have set the array to copy all three columns, but I only want column A and either column B OR C pasted in sheets 2 or 3. Looking at the code, I think that the line

With cell.EntireRow

is the reason for this, but I am unsure how to change it.

Here is my current code:

Option Compare Text
Sub SORT()
Dim cell As Range
Dim rngCat As Range
Dim rngOther As Range
Dim i As Long
Dim arrColsToCopy
Dim myDest As String
    myDest = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Address
    
    arrColsToCopy = Array(1, 2, 3)
    
    Set rngCat = Worksheets("sheet2").Range(myDest)
    Set rngOther = Worksheets("sheet3").Range(myDest)
    Application.ScreenUpdating = False
    For Each cell In Worksheets("sheet1").Range("A6:A1000").Cells
        If cell Like "*cat*" Then
            For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                With cell.EntireRow
                    .Cells(arrColsToCopy(i)).Copy rngCat.Offset(0, i)
                End With
            Next i
            Set rngCat = rngCat.Offset(1, 0)
            
            Else
            For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                With cell.EntireRow
                    .Cells(arrColsToCopy(i)).Copy rngOther.Offset(0, i)
                End With
            Next i
            Set rngOther = rngOther.Offset(1, 0)
            
        End If
    Next cell
    Application.ScreenUpdating = True
End Sub

Thank you kindly in advance!

 

[Brundles]

New Update:

After some additional tinkering I have managed to solve two of the three problems I had. The problem I am still having is with respect to the macro knowing which column to put in each sheet. I am fairly certain that it has to do with the following code:

 For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                With cell.EntireRow
                    .Cells(arrColsToCopy(i)).Copy rngChem.Offset(0, i)
                End With
            Next i

My question is this:

Can I change the line With cell.EntireRow to something else that will specify part of a row? If so, what?

Thanks to anyone who has read this far. I rarely do any programming, but this has been a very fun learning experience for me. Thanks!

 

[mikerickson]

You could try something like

With cell.EntireRow.Range("A1:G1")

which will act on rows A thru G of the same row as cell.


Note The .Range property of a range object is relative to the object, not the sheet. Thus

Sheets("Sheet1").Range("C3:D4")
is the same as
Sheets("Sheet1").Range("B2").Range("B2:C3")

 

[Brundles]

You could try something like

With cell.EntireRow.Range("A1:G1")

which will act on rows A thru G of the same row as cell.


Note The .Range property of a range object is relative to the object, not the sheet. Thus

Sheets("Sheet1").Range("C3:D4")
is the same as
Sheets("Sheet1").Range("B2").Range("B2:C3")

What if I only wanted part of a range? For example, in the range A1:G1, I only wanted A1:C1 and E1:G1 (omitting D1).

I was also thinking that the issue could be the LBound to UBound in my code. From what I understand:

arrColsToCopy = Array(1, 2, 3)

is telling the macro to copy the first 3 columns. Then I later have

For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                With cell.EntireRow
                    .Cells(arrColsToCopy(i)).Copy rngCat.Offset(0, i)
                End With

which pastes all three columns. I think that the LBound To UBound is what may be my hang up because I only want either column 1 and 2 OR 1 and 3. Any thoughts?

Maybe two arrays will work? As in array(1, 2) and array (1, 3). I will give this a try to see what happens.