Assistance with Looping Needed

[Philip1957]

Greetings,

I have some code that works, but but now I need to make it loop upwards through the blank cells and stop before overwriting the first non-blank cell. I just can't seem to figure out that whole "i = / Next i" thing.

Also, in the last "Else" statement if the cell (0,-13) from Active is blank I really don't want to write the string "Machine" in it. Is there a way to write an "Else Unless" statement?

Any assistance would be greatly appreciated.

Sub Assign_Category()

    Dim DfctCode As String
    
'    Select the Data worksheet  (Works)
    ActiveWorkbook.Sheets("Data").Select
    
'    Find the last Row  (Works)
    Selection.SpecialCells(xlCellTypeLastCell).Select
    
'    Paste category based on defect code  (Works)
    DfctCode = ActiveCell.Offset(0, -13)
            
            If InStr(DfctCode, "I") > 0 Then
            ActiveCell.Value = "Vendor"
            
            ElseIf InStr(DfctCode, "5") > 0 Or InStr(DfctCode, "22") > 0 _
            Or InStr(DfctCode, "26") > 0 Or InStr(DfctCode, "29") > 0 _
            Or InStr(DfctCode, "31") > 0 Then
            ActiveCell.Value = "Operator"
            
            ElseIf InStr(DfctCode, "I") > 0 Then
            ActiveCell.Value = "Vendor"

            Else: ActiveCell.Value = "Machine"
           
            End If
         
End Sub

Thank you for your time.

~ Phil

 

[wrightyrx7]

is the data always in the same columns? A and N for example? So it checks column A and the result goes in column N? Or do these columns change but are always 13 columns apart?

 

[GR00007]

ElseIf InStr(DfctCode, "I") > 0 Then
ActiveCell.Value = "Vendor"
Else: ActiveCell.Value = "Machine"
End If[/CODE]

The last ElseIf is redundant. Since DfctCode contains the value used for the decision, if it has a length of zero or is empty you could use that to make the active cell blank (or something like 'No value'.

ElseIf DfctCode = "" Then
ActiveCell.Value = ""    ' or "No Value"
Else: ActiveCell.Value = "Machine"
[COLOR=#333333]End If[/COLOR]

 

[Philip1957]

Always the same columns.

 

[Philip1957]

Thanks. Not sure why I didn't think of that. Must need more coffee!

 

[wrightyrx7]

Could make a copy of your workbook an see if this is what you need.

I have assuming the data is in coumns A & N but you can change as required.

Sub Assign_Category()


    Dim DfctCode As String, oPut As String
    Dim lRow As Long, i As Long
'    Select the Data worksheet  (Works)
    ActiveWorkbook.Sheets("Data").Select
    
'    Find the last Row  (Works)
    lRow = Selection.SpecialCells(xlCellTypeLastCell).Row


    With ativeworkbook.Sheets("Data")
'    Paste category based on defect code  (Works)
        For i = lRow To 2 Step -1
        
                '###Change A to the column you code is in###
                DfctCode = .Range("A" & i).Value
                
                If InStr(DfctCode, "I") > 0 Then
                    oPut = "Vendor"
                ElseIf InStr(DfctCode, "5") > 0 Or InStr(DfctCode, "22") > 0 _
                Or InStr(DfctCode, "26") > 0 Or InStr(DfctCode, "29") > 0 _
                Or InStr(DfctCode, "31") > 0 Then
                    oPut = "Operator"
                
                ElseIf Trim(DfctCode) = "" Then
                    oPut = ""
                Else
                    oPut = "Machine"
                End If
                '###Change N to the column you want the output to be in###
                .Range("N" & i).Value = oPut
        Next i
    End With
End Sub

 

[Philip1957]

wrightyrx7,

Very nice. I had to tweak it a bit by removing the "With" and now it works almost perfect.

S

ub Assign_Category()

    Dim DfctCode As String, oPut As String
    Dim lRow As Long, i As Long
    
'    Select the Data worksheet  (Works)
    ActiveWorkbook.Sheets("Data").Select
    
'    Find the last Row  (Works)
    lRow = Selection.SpecialCells(xlCellTypeLastCell).Row


'    Paste category based on defect code  (Works)
        For i = lRow To 2 Step -1
        
                DfctCode = Range("E" & i).Value
                
                If InStr(DfctCode, "I") > 0 Then
                    oPut = "Vendor"
                ElseIf InStr(DfctCode, "5") > 0 Or InStr(DfctCode, "22") > 0 _
                Or InStr(DfctCode, "26") > 0 Or InStr(DfctCode, "29") > 0 _
                Or InStr(DfctCode, "31") > 0 Then
                    oPut = "Operator"
                
                ElseIf Trim(DfctCode) = "" Then
                    oPut = ""
                Else
                    oPut = "Machine"
                End If
                Range("R" & i).Value = oPut
        Next i
End Sub

The only thing it didn't do is stop when it hit the first cell in column R that already had data in it.

The worksheet this will run on has 25K+ rows and we add about 1K per month. I don't want to have to reprocess the whole worksheet every time I run it.

[The file contains data from 2017, 2018, and now we are adding 2019. When we get to June '19 we will delete the 2017 records, keeping the size down to about 30K rows.]

In practice, this macro will get run twice per month. I'd like to keep the process time down by only updating the new rows.

Thank you very much for the assistance.

 

[wrightyrx7]

The only thing it didn't do is stop when it hit the first cell in column R that already had data in it.

The worksheet this will run on has 25K+ rows and we add about 1K per month. I don't want to have to reprocess the whole worksheet every time I run it.

[The file contains data from 2017, 2018, and now we are adding 2019. When we get to June '19 we will delete the 2017 records, keeping the size down to about 30K rows.]

In practice, this macro will get run twice per month. I'd like to keep the process time down by only updating the new rows.

Thank you very much for the assistance.

Try this

Sub Assign_Category()




    Dim DfctCode As String, oPut As String
    Dim lRowE As Long, lRowR As Long, i As Long
    Dim wsD As Worksheet
    
'    Select the Data worksheet  (Works)
    Set wsD = ActiveWorkbook.Sheets("Data")
    
    wsD.Select
    
    With wsD
'    Find the last Row  (Works)
    lRowE = .Cells(.Rows.Count, "E").End(xlUp).Row
    lRowR = .Cells(.Rows.Count, "R").End(xlUp).Row


'    Paste category based on defect code  (Works)
        For i = lRowE To lRowR Step -1
                DfctCode = .Range("E" & i).Value
                
                If InStr(DfctCode, "I") > 0 Then
                    oPut = "Vendor"
                ElseIf InStr(DfctCode, "5") > 0 Or InStr(DfctCode, "22") > 0 _
                Or InStr(DfctCode, "26") > 0 Or InStr(DfctCode, "29") > 0 _
                Or InStr(DfctCode, "31") > 0 Then
                    oPut = "Operator"
                ElseIf Trim(DfctCode) = "" Then
                    oPut = ""
                Else
                    oPut = "Machine"
                End If
                .Range("R" & i).Value = oPut
        Next i
    End With
End Sub

 

[Philip1957]

wrightyrx7,

Success, for the most part.

It overwrites the first not-blank cell but I'm OK with that. It will contain the same information as it did originally and it runs much faster since it doesn't have to go through all 12K rows in my test file. This will make a huge difference larger working file.

In the first piece of code you sent me I could see what you had done with i = / Next i and it helped me better understand how it works. I'll need to make the time to work through the section on looping in my VBA book.

With this new piece of code however, I don't understand what you did at all. I can't see anything in your code I recognize as an instruction to stop at the first non-blank cell in R. I don't want to take up any more of your time unnecessarily, but if you could briefly explain what you did, I'd appreciate it.

Thanks again for all your help. I'll get to that section on looping in my VBA book eventually, but the deadline I was given for this project didn't leave me any time to read & experiment.

Again, I can't thank you enough.

~ Phil

 

[wrightyrx7]

wrightyrx7,

Success, for the most part.

It overwrites the first not-blank cell but I'm OK with that. It will contain the same information as it did originally and it runs much faster since it doesn't have to go through all 12K rows in my test file. This will make a huge difference larger working file.

In the first piece of code you sent me I could see what you had done with i = / Next i and it helped me better understand how it works. I'll need to make the time to work through the section on looping in my VBA book.

With this new piece of code however, I don't understand what you did at all. I can't see anything in your code I recognize as an instruction to stop at the first non-blank cell in R. I don't want to take up any more of your time unnecessarily, but if you could briefly explain what you did, I'd appreciate it.

Thanks again for all your help. I'll get to that section on looping in my VBA book eventually, but the deadline I was given for this project didn't leave me any time to read & experiment.

Again, I can't thank you enough.

~ Phil

Hi again,


Basically i just added the below

    lRowE = .Cells(.Rows.Count, "E").End(xlUp).Row
    lRowR = .Cells(.Rows.Count, "R").End(xlUp).Row

It finds the last used row in column E and the last used row in column R

Then the loop starts on the last row thats been used in column E (lRowE) then works up to the last used row in column R (lRowR).

I understand what your saying about it overwriting the very last non blank.

If you change

    lRowR = .Cells(.Rows.Count, "R").End(xlUp).Row

to

    lRowR = .Cells(.Rows.Count, "R").End(xlUp).Row+1

it will fix that problem. It will find the last row in column R then add 1 to the value (which will be the first blank). Therefore, it will stop overwriting the last non blank < hope that makes sense lol