VBA Change "Status" in a different rows at the same time

[BluEEyE86]

Hello,

I have couple rows with the same number in Column2 as on below picture.

The most important is the first row because other 4 rows are saved purposly (usually don't know how many additional rows will be add). When I'm going to change status Column10 & write cells in Column12 & Column13, I'd like to do the same with other rows with the same number in Column2 in the same time. I know how to update one row & VBA code is below. I tried to do it with Do Loop While but It's not working. Any idea how to improve below code ?

Sub Update()
    
    Dim sh As Worksheet
    Dim iRow As Long
    Dim OutApp As Object, adresaci, sciezka$, att$
    Dim OutMail As Object
    Dim OutAppTSR As Object, TSR, sciezka2$, att2$
    Dim OutMailTSR As Object
    Dim mfgType As String
    Dim TSRname As String
    Dim TSRnumber As String
    Dim TSRemail As String
    Dim MFGStatus As String
    Dim regDtm As String
    
    'Worksheets("Database").Unprotect Password:="LabABCD"
    
    With ThisWorkbook.Worksheets("email")
        adresaci = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

    If IsArray(adresaci) Then adresaci = Join(WorksheetFunction.Transpose(adresaci), "; ")
    
    With ThisWorkbook.Worksheets("email")
        TSR = .Range("B1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

    If IsArray(TSR) Then TSR = Join(WorksheetFunction.Transpose(TSR), "; ")
    
    Set sh = ThisWorkbook.Sheets("Database")
        
    ThisWorkbook.Sheets("Database").Activate
        
    'Do
    
    Range(B1).Activate
    
    Cells.Find(What:=mapFORM.txtRollNo, After:=ActiveCell, LookIn:=xlValues).Activate
        
    iRow = ActiveCell.Row
    
    mfgType = Cells(iRow, 6)
    MFGStatus = Cells(iRow, 10)
    TSRname = Cells(iRow, 17)
    TSRnumber = Cells(iRow, 18)
            
         With sh
             
             .Cells(iRow, 6) = mapFORM.ComboBox4
             
             .Cells(iRow, 7) = mapFORM.txtSample
             
             .Cells(iRow, 10) = mapFORM.cmbStatus
         
             
            
            If MFGStatus = "Niezarejestrowana" Then
            
                        If mapFORM.cmbStatus = "Zwolnione" Or mapFORM.cmbStatus = "Zamkniete" Or mapFORM.cmbStatus = "Decyzja" Or mapFORM.cmbStatus = "Retest" Or mapFORM.cmbStatus = "Odrzucone" Then
                                   
                                   If regDtm = "" Then
                            
                                       MsgBox ("Zlecenie MFG nie zostalo jeszcze zarejestrowane w laboratorium i nie mozna go zwolnic. Najpierw zarejestruj material ze statusem Otwarte.")
                                       Exit Sub
                                   
                                   End If
                                   
                               Else: mapFORM.cmbStatus = "Otwarte"
                               
                               .Cells(iRow, 8) = [Text(Now(), "MM/DD/YYYY HH:MM")]
                               .Cells(iRow, 10) = mapFORM.cmbStatus
                               .Cells(iRow, 11) = mapFORM.cbApprover
                               
                        End If
                        
                    Else
                            
                        .Cells(iRow, 10) = mapFORM.cmbStatus
                        .Cells(iRow, 12) = [Text(Now(), "MM/DD/YYYY HH:MM")]
                        .Cells(iRow, 13) = mapFORM.cbApprover
                        
            End If
            
             .Cells(iRow, 14).Value = Application.WorksheetFunction.IsoWeekNum(.Cells(iRow, 8).Value)
         
             .Cells(iRow, 15) = mapFORM.ComboBox1
         
             .Cells(iRow, 16) = mapFORM.txtComment
         
            If Cells(iRow, 19) = "" Then
            
                If mapFORM.cmbStatus = "Retest" Then
                
                    .Cells(iRow, 19) = "TAK"
                    .Cells(iRow, 20) = mapFORM.cbRetest1
                    .Cells(iRow, 21) = mapFORM.cbRetest2
                    .Cells(iRow, 22) = mapFORM.cbRetest3
                    
                Else: .Cells(iRow, 19) = "NIE"
            
                End If
            
            End If
            
         End With
         
    'Loop While Cells.Find(What:=mapFORM.txtRollNo, After:=ActiveCell, LookIn:=xlValues).Offset(8, 0) <> "Otwarte"
    
End Sub

 

[lordgav]

Where is your for loop? All of your code you have shown is not relevant to your question. None of the additional rows are the same. How do you know what the differences are?

 

[BluEEyE86]

I mentioned already that above code is just for one row - always first row with number in Column2. I've tried to use Do Loop Untill but w/o success. I didn't use For Loop for this so far. Rows aren't identical but some data are the same w/o Column1. I'd like to relay on Column2 because this is uniqe number for my needs which represnta batch no. Row no are different & will be assigned randomly always.

 

[lordgav]

Your question really isn't very clear. If you change the status in Column status row 1, are you wanting to change the status in all the other rows of the same serial number? What is your code meant to be doing in regard to your question?

 

[BluEEyE86]

If you change the status in Column status row 1, are you wanting to change the status in all the other rows of the same serial number?

This is exactly what the code should do. Top row is major row for serial number. If this row has "Status" approved in column10, then all rows with the same serial number need to have the same status. Above code can change status only for top row. If someone would help me to loop it for next rows with the same serial number. I'll appreaciate it.

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: [VBA - UserForm] Change "Status" cells in all duplicated rows at the same time - OzGrid Free Excel/VBA Help Forum
and [VBA - UserForm] Change "Status" cells in all duplicated rows at the same time
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[BluEEyE86]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules. Be sure to follow & read the link at the end of the rule too! Cross posted at: [VBA - UserForm] Change "Status" cells in all duplicated rows at the same time - OzGrid Free Excel/VBA Help Forum and [VBA - UserForm] Change "Status" cells in all duplicated rows at the same time If you have posted the question at more places, please provide links to those as well. If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules. Be sure to follow & read the link at the end of the rule too! Cross posted at: [VBA - UserForm] Change "Status" cells in all duplicated rows at the same time - OzGrid Free Excel/VBA Help Forum and [VBA - UserForm] Change "Status" cells in all duplicated rows at the same time If you have posted the question at more places, please provide links to those as well. If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[BluEEyE86]

Apologize for cross-posting & above replay. Above post can be deleted as it was site loading issue. It was really important for me but finally I solved the issue by myself using simple CountIf worksheet function & For loop.

Sub Update()
    
    Dim sh As Worksheet
    Dim iRow As Long
    Dim OutApp As Object, adresaci, sciezka$, att$
    Dim OutMail As Object
    Dim OutAppTSR As Object, TSR, sciezka2$, att2$
    Dim OutMailTSR As Object
    Dim mfgType As String
    Dim TSRname As String
    Dim TSRnumber As String
    Dim TSRemail As String
    Dim MFGStatus As String
    Dim regDtm As String
    Dim j As Long
    Dim lastRow As Long
    Dim DupCount As Long
       
    Set sh = ThisWorkbook.Sheets("Database")
        
    ThisWorkbook.Sheets("Database").Activate
    
    sh.Range("B1").Activate
            
    i = Range("B" & Rows.Count).End(xlUp).Row
        
        DupCount = Application.WorksheetFunction.CountIf(Range("B:B"), mapFORM.txtRollNo)
        
    For j = 1 To DupCount
    
    Cells.Find(What:=mapFORM.txtRollNo, After:=ActiveCell, LookIn:=xlValues, SearchOrder:=xlByRows).Activate
        
    iRow = ActiveCell.Row
    
    mfgType = Cells(iRow, 6)
    MFGStatus = Cells(iRow, 10)
    TSRname = Cells(iRow, 17)
    TSRnumber = Cells(iRow, 18)
            
         With sh
             
            If Cells(iRow, 6).Value = "" Then
                         
             .Cells(iRow, 6) = mapFORM.ComboBox4
             
            End If
                
            If Cells(iRow, 7).Value = "" Then
            
             .Cells(iRow, 7) = mapFORM.txtSample
             
             End If
             
             .Cells(iRow, 10) = mapFORM.cmbStatus
         
             
            
            If MFGStatus = "Niezarejestrowana" Then
            
                        If mapFORM.cmbStatus = "Zwolnione" Or mapFORM.cmbStatus = "Zamkniete" Or mapFORM.cmbStatus = "Decyzja" Or mapFORM.cmbStatus = "Retest" Or mapFORM.cmbStatus = "Odrzucone" Then
                                   
                                   If regDtm = "" Then
                            
                                       MsgBox ("Zlecenie MFG nie zostalo jeszcze zarejestrowane w laboratorium i nie mozna go zwolnic. Najpierw zarejestruj material ze statusem Otwarte.")
                                       Exit Sub
                                   
                                   End If
                                   
                               Else: mapFORM.cmbStatus = "Otwarte"
                               
                               .Cells(iRow, 8) = [Text(Now(), "MM/DD/YYYY HH:MM")]
                               .Cells(iRow, 10) = mapFORM.cmbStatus
                               .Cells(iRow, 11) = mapFORM.cbApprover
                                    
                               
                               
                        End If
                        
                    Else
                            
                        .Cells(iRow, 10) = mapFORM.cmbStatus
                        .Cells(iRow, 12) = [Text(Now(), "MM/DD/YYYY HH:MM")]
                        .Cells(iRow, 13) = mapFORM.cbApprover
                        
            End If
            
             .Cells(iRow, 14).Value = Application.WorksheetFunction.IsoWeekNum(.Cells(iRow, 8).Value)
         
             .Cells(iRow, 15) = mapFORM.ComboBox1
         
             .Cells(iRow, 16) = mapFORM.txtComment
         
            If Cells(iRow, 19) = "" Then
            
                If mapFORM.cmbStatus = "Retest" Then
                
                    .Cells(iRow, 19) = "TAK"
                    .Cells(iRow, 20) = mapFORM.cbRetest1
                    .Cells(iRow, 21) = mapFORM.cbRetest2
                    .Cells(iRow, 22) = mapFORM.cbRetest3
                    
                Else: .Cells(iRow, 19) = "NIE"
            
                End If
            
            End If
            
         End With
    
    Next j

End Sub