Answered by:
Macro for check cells
Question

Hello , I have been trying the following and I can not do it
In sheet “OP” you must go through the codes reported in the field "Work Code", checking that the same code has been incorporated in the field "Work Code" of sheet “AP”. In case any code is not found in the sheet “AP”, the macro should check if it is in the "Related Work Code" field on sheet “AS”. If it is not found on this sheet either, it should show the code in page “Result”
Sheet “OP”
System System2 Work Code 158 1213 1
Sheet “AP”
Recent Work type Type code Work Code 1213
Sheet “AS”
System local x City Code ccity Tyoer Related code Tyoer Related code Related Work Code 15
Expect result codes : 158 , 1
My code don’t work ;/
Regards
Answers

Please give this a try...
Private Sub check_Click() Dim wsOP As Worksheet, wsAP As Worksheet, wsAS As Worksheet, wsResult As Worksheet Dim lr As Long, i As Long, j As Long Dim Crit Dim x, y() Set wsOP = Worksheets("OP") Set wsAP = Worksheets("AP") Set wsAS = Worksheets("AS") Set wsResult = Worksheets("Result") 'Assuming Work Codes are in column C on OP Sheet lr = wsOP.Cells(Rows.Count, "C").End(xlUp).Row x = wsOP.Range("C2:C" & lr).Value If lr = 2 Then Crit = wsOP.Range("C2").Value If Application.CountIf(wsAP.Columns("D"), Crit) = 0 And Application.CountIf(wsAS.Columns("H"), Crit) = 0 Then ReDim y(1 To 1, 1 To 1) j = 1 y(1, 1) = Crit End If Else ReDim y(1 To UBound(x, 1), 1 To 1) For i = 1 To UBound(x, 1) If Application.CountIf(wsAP.Columns("D"), x(i, 1)) = 0 And Application.CountIf(wsAS.Columns("H"), x(i, 1)) = 0 Then j = j + 1 y(j, 1) = x(i, 1) End If Next i End If 'Writing work codes on Result Sheet wsResult.Columns(1).Clear wsResult.Range("A1").Value = "Work Codes" wsResult.Range("A2").Resize(j).Value = y End Sub
Subodh Tiwari (Neeraj) sktneer
 Marked as answer by LoganTRK Monday, February 11, 2019 3:50 PM
All replies


Since you didn't share your code so not sure what didn't work but this looks simple. You may try the below approach after tweaking it if required.
Sub WorkCodes() Dim wsOP As Worksheet, wsAP As Worksheet, wsAS As Worksheet, wsResult As Worksheet Dim lr As Long, i As Long, j As Long Dim x, y() Set wsOP = Worksheets("OP") Set wsAP = Worksheets("AP") Set wsAS = Worksheets("AS") Set wsResult = Worksheets("Result") 'Assuming Work Codes are in column C on OP Sheet lr = wsOP.Cells(Rows.Count, "C").End(xlUp).Row x = wsOP.Range("C2:C" & lr).Value ReDim y(1 To UBound(x, 1), 1 To 1) 'Assuming Work Codes on AP Sheet are in column D 'Assuming Work Codes on AS Sheet are in column G For i = 1 To UBound(x, 1) If Application.CountIf(wsAP.Columns("D"), x(i, 1)) = 0 And Application.CountIf(wsAS.Columns("G"), x(i, 1)) = 0 Then j = j + 1 y(j, 1) = x(i, 1) End If Next i 'Writing work codes on Result Sheet wsResult.Columns(1).Clear wsResult.Range("A1").Value = "Work Codes" wsResult.Range("A2").Resize(j).Value = y End Sub
Subodh Tiwari (Neeraj) sktneer




Please give this a try...
Private Sub check_Click() Dim wsOP As Worksheet, wsAP As Worksheet, wsAS As Worksheet, wsResult As Worksheet Dim lr As Long, i As Long, j As Long Dim Crit Dim x, y() Set wsOP = Worksheets("OP") Set wsAP = Worksheets("AP") Set wsAS = Worksheets("AS") Set wsResult = Worksheets("Result") 'Assuming Work Codes are in column C on OP Sheet lr = wsOP.Cells(Rows.Count, "C").End(xlUp).Row x = wsOP.Range("C2:C" & lr).Value If lr = 2 Then Crit = wsOP.Range("C2").Value If Application.CountIf(wsAP.Columns("D"), Crit) = 0 And Application.CountIf(wsAS.Columns("H"), Crit) = 0 Then ReDim y(1 To 1, 1 To 1) j = 1 y(1, 1) = Crit End If Else ReDim y(1 To UBound(x, 1), 1 To 1) For i = 1 To UBound(x, 1) If Application.CountIf(wsAP.Columns("D"), x(i, 1)) = 0 And Application.CountIf(wsAS.Columns("H"), x(i, 1)) = 0 Then j = j + 1 y(j, 1) = x(i, 1) End If Next i End If 'Writing work codes on Result Sheet wsResult.Columns(1).Clear wsResult.Range("A1").Value = "Work Codes" wsResult.Range("A2").Resize(j).Value = y End Sub
Subodh Tiwari (Neeraj) sktneer
 Marked as answer by LoganTRK Monday, February 11, 2019 3:50 PM

