Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
menu search
person
Welcome To Ask or Share your Answers For Others

Categories

I have multiple worksheets in a workbook. I have data in columns I and K starting at row 3. I want to say that if I is greater than K mark “TRUE” in column P. If I is less than K mark “FALSE” in column P.

I then want to say that if P3 is TRUE and P4 is FALSE, then mark a “1” in Q for that row. If P4 is FALSE and P4 is TRUE, then mark a “2” in Q for that row. If P3 is TRUE and P4 is TRUE, ignore it, and if P3 is FALSE, and P4 is FALSE, ignore it also. Then carry on through the worksheet, for P4 comparing to P5 etc.

Then, I want for any lines that have a 1 or a 2 in them, for those lines to be copied, and taken across to a worksheet called Analysis, and pasted in the next available row. I then want to loop through to the next worksheet and do it all again, until it has been done on all worksheets. I haven't written any code for this bit yet, as I can't get the first bit to work.

The code I have tried is this.

    Dim lr As Long
    Dim pr As Long
    Dim i As Long
    Dim cval As Variant
    Dim pval As Variant

    lr = ActiveSheet.Cells(Rows.Count, "K").End(xlUp).Row 

    ActiveSheet.Range("P3:P" & lr).ClearContents 

    pval = "" 

    ActiveSheet.Range("P3").Select
    ActiveCell.FormulaR1C1 = "=RC[-7]>RC[-5]"
    Range("P3").Select
    Selection.Copy
    Range("P4:P195").Select
    ActiveSheet.Paste

    For i = 3 To lr

      'note that cval is current value - i.e. for us this would be P4, 
      '   because previous value is P3 - it checks the current value 
      '   against the previous value to tell if they are the same.
    cval = ActiveSheet.Range("P" & i).Value 
    pval = ActiveSheet.Range("P" & i + 1).Value
     
    If cval <> "" Then 
            If cval = "FALSE" And pval = "FALSE" Then ActiveSheet.Range("Q").Value = ""
            ElseIf cval = "FALSE" And pval = "TRUE" Then ActiveSheet.Range("Q").Value = "1"
            ElseIf cval = "TRUE" And pval = "TRUE" Then ActiveSheet.Range("Q").Value = ""
            ElseIf cval = "TRUE" And pval = "FALSE" Then ActiveSheet.Range("Q").Value = "2"

    End If
  
        
        pval = cval 
        pr = i 
    
    End If
    
    Next i

Any help would be greatly appreciated! Thanks!

question from:https://stackoverflow.com/questions/66056423/vba-cval-and-pval

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
114 views
Welcome To Ask or Share your Answers For Others

1 Answer

Something like this should work:

Sub CheckSheets()
    
    Dim sht As Worksheet, rng As Range, rw As Range
    Dim lr As Long, lrA As Long, seq, wsAn As Worksheet
    
    Set wsAn = ThisWorkbook.Sheets("Analysis")
    lrA = wsAn.Cells(Rows.Count, "Q").End(xlUp).Row + 1 'next open row on Analysis
    
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> wsAn.Name Then                        'exclude the Analysis sheet
            lr = sht.Cells(Rows.Count, "K").End(xlUp).Row    'last used row on sheet
            Set rng = sht.Range("A3:Q" & lr)                 'adjust last column as required
            
            rng.Columns("P").FormulaR1C1 = "=RC[-7]>RC[-5]"  'add the formula
            
            For Each rw In rng.Rows 'loop over the data rows
                
                'combine the two P values
                seq = IIf(rw.Columns("P").Value, "T", "F") & _
                      IIf(rw.Columns("P").Offset(1, 0).Value, "T", "F")
                'check which combination we have
                If seq = "FT" Or seq = "TF" Then
                    rw.Columns("Q").Value = IIf(seq = "FT", 1, 2)
                    rw.Copy wsAn.Cells(lrA, "A")
                    lrA = lrA + 1 'next destination row
                Else
                    rw.Columns("Q").ClearContents
                End If
            Next rw
        End If
    Next sht

End Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
...