Period data

[Bryan_Mc]

Can anyone help with the code below. This code is exactly whay i am looking for and I will be able to adapt it and use it for my purposes if i can get it to go to D2,D3,D4 etc

Thanks




Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim Dn As Range
Dim dt As Date
Dim fd As Boolean
Dim ws As Worksheet
If Target.Address(0, 0) = "D1" Then
Set rng = ActiveWorkbook.Names("Periods_PeriodNumber").RefersToRange
For Each Dn In rng
If CDate(Dn(, 2)) <= Range("D1") And CDate(Dn(, 3)) >= Range("D1") Then
Range("E1") = Dn
fd = True
Exit For
End If
Next Dn
If fd = False Then Range("E1") = "No Match Found"
End If
End Sub

 

[bertie]

The Target.Address returns an absolute reference.

   [COLOR=darkblue]If[/COLOR] Target.Address <> "$D$1" [COLOR=darkblue]Then[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]

NB You are going to write something to the worksheet. This will trigger the Worksheet_Change event again. If you don't want this to happen then disable events whilst writing to the sheet. This will cause problems if an error occurs and the application is not reset, so include an error trap.

   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] ResetApplication
 
         [COLOR=green]'rest of code goese here[/COLOR]
 
ResetApplication:
   Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Set up your range and your flag:

   [COLOR=darkblue]Set[/COLOR] rng = Range("Periods_PeriodNumber")
   fd = [COLOR=darkblue]False[/COLOR]

When you create the date you need to offset the range "dn"

   [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] Dn [COLOR=darkblue]In[/COLOR] rng
      [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]CDate[/COLOR](Dn.Offset(, 2)) <= Range("D1") _
         And [COLOR=darkblue]CDate[/COLOR](Dn.Offset(, 3)) >= Range("D1") [COLOR=darkblue]Then[/COLOR]

And when writing to the sheet switch off events.
Reset the flag and,
Exit the loop

         [COLOR=green]'switch off events whilst writing to sheet[/COLOR]
         Application.EnableEvents = [COLOR=darkblue]False[/COLOR]
            Range("E1") = Dn
         Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
         fd = [COLOR=darkblue]True[/COLOR]
         [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]

The same applies when writing for the false flag:

   [COLOR=darkblue]If[/COLOR] fd = [COLOR=darkblue]False[/COLOR] [COLOR=darkblue]Then[/COLOR]
      [COLOR=green]'switch off events whilst writing to sheet[/COLOR]
      Application.EnableEvents = [COLOR=darkblue]False[/COLOR]
         Range("E1") = "No Match Found"
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]

Putting it all together:

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_Change([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)
   [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range
   [COLOR=darkblue]Dim[/COLOR] Dn [COLOR=darkblue]As[/COLOR] Range
   [COLOR=darkblue]Dim[/COLOR] dt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] fd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]If[/COLOR] Target.Address <> "$D$1" [COLOR=darkblue]Then[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] ResetApplication
 
   [COLOR=darkblue]Set[/COLOR] rng = Range("Periods_PeriodNumber")
   fd = [COLOR=darkblue]False[/COLOR]
 
   [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] Dn [COLOR=darkblue]In[/COLOR] rng
      [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]CDate[/COLOR](Dn.Offset(, 2)) <= Range("D1") _
         And [COLOR=darkblue]CDate[/COLOR](Dn.Offset(, 3)) >= Range("D1") [COLOR=darkblue]Then[/COLOR]
 
         [COLOR=green]'switch off events whilst writing to sheet[/COLOR]
         Application.EnableEvents = [COLOR=darkblue]False[/COLOR]
            Range("E1") = Dn
         Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
         fd = [COLOR=darkblue]True[/COLOR]
         [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=darkblue]Next[/COLOR] Dn
 
   [COLOR=darkblue]If[/COLOR] fd = [COLOR=darkblue]False[/COLOR] [COLOR=darkblue]Then[/COLOR]
      [COLOR=green]'switch off events whilst writing to sheet[/COLOR]
      Application.EnableEvents = [COLOR=darkblue]False[/COLOR]
         Range("E1") = "No Match Found"
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
ResetApplication:
   Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps.
Bertie

 

[AlphaFrog]

I read your question that you wanted to trigger on any change in a cell in column D.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim Dn As Range
    Dim fd As Boolean
    
    If Target.Column = 4 And Target.Count = 1 Then
    
        Set rng = ActiveWorkbook.Names("Periods_PeriodNumber").RefersToRange
        For Each Dn In rng
            If CDate(Dn(, 2)) <= Target And CDate(Dn(, 3)) >= Target Then
                Application.EnableEvents = False
                    Target.Offset(, 1) = Dn
                Application.EnableEvents = True
                fd = True
                Exit For
            End If
        Next Dn
        
        If fd = False Then
            Application.EnableEvents = False
                Target.Offset(, 1) = "No Match Found"
            Application.EnableEvents = True
        End If
        
    End If
    
End Sub

 

[Bryan_Mc]

Thanks for the help it works great. Just a little more help if possible, How do i get it to update all of column D without doing it cell by cell Thanks

 

[Bryan_Mc]

Thanks for the help it works great. Just a little more help if possible, How do i get it to update all of column D without doing it cell by cell Thanks

 

[AlphaFrog]

...it works great.

What works great? You had two different answers.

How do i get it to update all of column D without doing it cell by cell

Do you want to loop for all used cell in column D and NOT have a Worksheet_Change event macro? Please be a little more verbose.

 

[Bryan_Mc]

Sorry AlphaFrog, i think you can tell i am a novice at this. I am also sure that bertie's will work fine, but your version is the first one i have got to work for my requirements apart from the small glitch with the whole of column D being update in one go


Thanks

 

[AlphaFrog]

Sub Periods()

    Dim rng As Range
    Dim Dn As Range, cellD As Range
    
    Set rng = ActiveWorkbook.Names("Periods_PeriodNumber").RefersToRange
    
    For Each cellD In Range("D1", Range("D" & Rows.Count).End(xlUp))
        If IsDate(cellD) Then
        
            cellD.Offset(, 1) = "No Match"
            For Each Dn In rng
            
                If CDate(Dn(, 2)) <= cellD And CDate(Dn(, 3)) >= cellD Then
                    cellD.Offset(, 1) = Dn
                    Exit For
                End If
                
            Next Dn
            
        End If
    Next cellD
    
End Sub

 

[Bryan_Mc]

Thanks AlphaFrog,

It work perfect.