BluEEyE
02-15-2022, 12:08 AM
Hello,
I'm going to prepare program to increase efficiency & save time. I have an UserForm when I'm going to add some rows. UserForm below:
29403
After this, I have below situation where I have few rows duplicated by serial no in Column2.
29404
Serial number is my uniqe number everywhere & it's written always. Major row is always this one from the TOP. I have written a VBA code which is going to change "Status" in Column 10 but only for one TOP row but I need to modify this code to change the same column 10 in all dublicated row with the same serial no. Below is my code. Can you please help me with this ?
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 i As Long
'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
sh.Range("B1").Activate
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
.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
End Sub
I'm going to prepare program to increase efficiency & save time. I have an UserForm when I'm going to add some rows. UserForm below:
29403
After this, I have below situation where I have few rows duplicated by serial no in Column2.
29404
Serial number is my uniqe number everywhere & it's written always. Major row is always this one from the TOP. I have written a VBA code which is going to change "Status" in Column 10 but only for one TOP row but I need to modify this code to change the same column 10 in all dublicated row with the same serial no. Below is my code. Can you please help me with this ?
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 i As Long
'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
sh.Range("B1").Activate
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
.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
End Sub