none
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
    15-8
    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 : 15-8 , 1 

    My code don’t work ;/

    Regards
    Tuesday, February 5, 2019 2:00 PM

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
    Monday, February 11, 2019 3:37 PM

All replies

  • Hi,

    (1) I'm afraid you need to provide your code.
    (2) What is page "Result"?  Is it a worksheet?

    Regards,

    Ashidacchi -- https://ssl01.rocketnet.jp/hokusosha.com/default.html

    Wednesday, February 6, 2019 3:52 AM
  • 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

    Wednesday, February 6, 2019 4:26 AM
  • The code send  me this error :  Type mismatch (error 13)

    In this line :

    ReDim y(1 To UBound(k, 1), 1 To 1) , u can help me ?

    Monday, February 11, 2019 12:52 PM
  • It is hard to tell without seeing your file.

    It would be better if you upload a truncated version of your file (after removing any sensitive data) either on Onedrive or Google Drive or DropBox and share the link here.


    Subodh Tiwari (Neeraj) sktneer

    Monday, February 11, 2019 2:15 PM
  • check this link please

    https://1drv.ms/f/s!AoDBxkYIpcK2gRGQNBIksyUU-F5J

    Monday, February 11, 2019 2:41 PM
  • 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
    Monday, February 11, 2019 3:37 PM
  • Works! Thank you  so much 
    Monday, February 11, 2019 3:52 PM
  • You're welcome!

    Subodh Tiwari (Neeraj) sktneer

    Monday, February 11, 2019 4:04 PM