Posts by StephenR

Try this. One of the Find parameters specifies an exact or partial match.

Sub x()


Dim obj As Range, wsActiveSheet As Worksheet, AreaY As Long, AreaX As Long


Set obj = wsActiveSheet.Cells.Find(what:="Area", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If obj Is Nothing Then
    MsgBox "Target column is not found"
Else
    AreaY = obj.Row
    AreaX = obj.Column
End If


Columns(AreaX).Copy Cells(1, 101)


End Sub

I hadn't realised you were already using Event code. I don't think I will be able to help. I can do (1) but doubt I can improve on (2) and not sure (3) is possible.

OK I'm not sure how your system will work so perhaps we can do a little test. This is not really answering your questions, but if it works I know the approach is broadly correct and if it doesn't work it will need a re-think.

Can you paste this code into the sheet module (right-click the sheet tab, View Code and paste):

Private Sub Worksheet_Calculate()


If Range("A1").Value = 1 Then
    Range("E2").Value = WorksheetFunction.Max(Range("B2:B10"))
End If


End Sub

When the sheet calculates, if A1=1 it should just put the max of B2:B10 in E2.

Let me know how you get on.

______________________

EDIT: if that doesn't work, can you try this code in the module of sheet "7" and see if it runs whenever I2 is changed.

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Address = "$I$2" Then
    With Worksheets("H019")
        If .Range("A1").Value = 1 Then
            .Range("E2").Value = WorksheetFunction.Max(.Range("B2:B10"))
        End If
    End With
End If


End Sub

OK that has shed some light.

Are you able to add these formula to the workbook or the thread here? I ask because I wonder if the values are coming from an external system as opposed to being generated within Excel.

So if E2 is the maximum of B2:B10 what goes in E3? Will A1 go back to 0 and then back to 1 and you put the next maximum in E3? How is A1 being updated?

Think you can just remove that whole For loop.

Try this (untested). Adjust sheet names to suit.

Sub x()


Dim r1 As Long, r2 As Long


With Sheets("Sheet1") 'source sheet
    r2 = 3
    For r1 = 9 To .Cells(Rows.Count, "G").End(xlUp).Row Step 2
         Sheets("Sheet2").Cells(r2, "B").Value = .Cells(r1, "G").Value
         Sheets("Sheet2").Cells(r2, "DX").Value = .Cells(r1 + 1, "G").Value
         r2 = r2 + 1
    Next r1
End With


End Sub

Please use code tags in future as per forum rules.

Think you just need

wksTarget.Range("D19").Value = "=(B19-A19) + " & DaysToCompletion

Anything in quotes will appear literally.

This site is getting painful so everything is hard work at the moment. (Can't attach a file either.) It works for me on your attached file with 0.8 / 1.1. I noticed that with some settings its possible that a trigger point is not reached before the next min/max is reached and that can cause an error. Should it automatically stop in those cases? The code runs for me from the button.

Works for me Art. When I run it I get

1.08295 in I30
1.07442 in J84

etc.

What values are you getting?

You can call the macros from each other so running one runs them all. (Also suggest you give mine a better name!)

Glad it worked Art.

Please use code tags in future as per forum rules.

I would move the workbook.close and two following lines to after the paste line. You are probably clearing the clipboard.

Keep your existing Copy line and add my code afterwards, keeping it on two lines as I posted it.

You can play around with the colours if you're fussed.

Sub x()
 
Dim r As Range, sAddr As String, n As Long, i As Long


n = Range("B" & Rows.Count).End(xlUp).Row


Range("I2:J" & n).Clear


With Range("C2:D" & n)
    Set r = .Find(What:="*", After:=Range("D" & n), Lookat:=xlWhole, SearchOrder:=xlByRows, _
                      SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not r Is Nothing Then
        sAddr = r.Address
        Do
          i = r.Row
          If r.Column = 3 Then
            Do Until Cells(i, 2) <= r.Offset(, 2)
                i = i + 1
            Loop
            Cells(i, 10) = Cells(i, 2)
            Cells(i, 10).Interior.Color = RGB(0, 255, 0)
           Else
            Do Until Cells(i, 2) >= r.Offset(, 2)
                i = i + 1
            Loop
            Cells(i, 9) = Cells(i, 2)
            Cells(i, 9).Interior.Color = RGB(255, 0, 0)
          End If
          Set r = .FindNext(r)
         Loop While r.Address <> sAddr
    End If
End With
     
End Sub

Yes, but that is an easy change to make.

Doesn't it relate to the maximum in row 147?

"I plan to post this request in a few other forums, as well"

Please read the rules here on cross-posting before doing so.

Might be enough to add this after your current Copy line:

.Copy
Sheets(s).cells(1).pastespecial xlPasteColumnWidths

If you take one of the values you didn't flag up, e.g. in I174, can you identify an issue there? Did you overlook it? If it's not right what's the logic?

OK, I've had a stab, though can't quite replicate the results. This code is adding a few more values than you indicated. The results are placed in column I, coloured green.

If can iron out the method, can then address speed if it's an issue, probably by using arrays rather than operating on the sheet.

Sub x()
 
Dim r As Range, sAddr As String, n As Long, i As Long


n = Range("B" & Rows.Count).End(xlUp).Row


With Range("C2:D" & n)
    Set r = .Find(What:="*", After:=Range("D" & n), Lookat:=xlWhole, SearchOrder:=xlByRows, _
                      SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not r Is Nothing Then
        sAddr = r.Address
        Do
          i = r.Row
          If r.Column = 3 Then
            Do Until Cells(i, 2) <= r.Offset(, 2)
                i = i + 1
            Loop
            
           Else
            Do Until Cells(i, 2) >= r.Offset(, 2)
                i = i + 1
            Loop
          End If
          Cells(i, 9) = Cells(i, 2)
          Set r = .FindNext(r)
         Loop While r.Address <> sAddr
    End If
End With
     
End Sub