Calibrations

[Legacy 436357]

Hi,

I was wondering if someone can help me please. I have a long list of equipment that requires calibrations on different cycles. Some weekly, monthly, semi-annual, and annual. I request some sort of way to automate the process as far as showing what is due.

I would like to attach file example if possible.

Thank you very much,
Bill

 

[Legacy 436357]

Hi and thank you for the code. I changed my sheet to Equipment and assigned it to a shape. When clicking it went to debug mode and highlighted the line:

If Month(AR(i, 1)) = 11 Then

Sub CopyNovember()
Dim wsEquip  As Worksheet: Set wsEquip = Sheets("Equipment") 'Change sheet to whatever yours is named
Dim wsNov   As Worksheet: Set wsNov = Sheets("November")
Dim AR()    As Variant: AR = wsEquip.Range("A1").CurrentRegion.Value
Dim LR      As Long
Dim R       As Range




For i = 2 To UBound(AR)
    If Month(AR(i, 1)) = 11 Then
        LR = wsNov.Range("A" & Rows.Count).End(xlUp).Row() + 1
        Set R = wsNov.Range("A" & LR).Resize(1, UBound(AR, 2))
        tmp = Application.Index(AR, i, 0)
        R.Value = tmp
    End If
Next i




End Sub

 

[lrobbo314]

I ran into that error as well. It happens when the value in the array isn't a date. That's why the for loop starts at 2, to skip the header row. At least I am guessing it's the same error. Does your data start in A1 on your 'Equipment' sheet? If it is just a matter of the value not being a date, the code below should be able to handle it.

Sub CopyNovember()


Dim wsMain  As Worksheet: Set wsMain = Sheets("Equipment") 'Change sheet to whatever yours is named
Dim wsNov   As Worksheet: Set wsNov = Sheets("November")
Dim AR()    As Variant: AR = wsMain.Range("A1").CurrentRegion.Value
Dim LR      As Long
Dim R       As Range


For i = 2 To UBound(AR)
    If IsDate(AR(i, 1)) Then
        If Month(AR(i, 1)) = 11 Then
            LR = wsNov.Range("A" & Rows.Count).End(xlUp).Row() + 1
            Set R = wsNov.Range("A" & LR).Resize(1, UBound(AR, 2))
            tmp = Application.Index(AR, i, 0)
            R.Value = tmp
        End If
    End If
Next i


End Sub

 

[Legacy 436357]

The data starts in A3 on both sheets. They are also both tables does that matter?

 

[lrobbo314]

Yeah, try this one...

Sub CopyNovember()


Dim wsMain  As Worksheet: Set wsMain = Sheets("Equipment") 'Change sheet to whatever yours is named
Dim wsNov   As Worksheet: Set wsNov = Sheets("November")
Dim AR()    As Variant: AR = wsMain.Range("A3").CurrentRegion.Value
Dim LR      As Long
Dim R       As Range


For i = 2 To UBound(AR)
    If IsDate(AR(i, 1)) Then
        If Month(AR(i, 1)) = 11 Then
            LR = wsNov.Range("A" & Rows.Count).End(xlUp).Row() + 1
            Set R = wsNov.Range("A" & LR).Resize(1, UBound(AR, 2))
            tmp = Application.Index(AR, i, 0)
            R.Value = tmp
        End If
    End If
Next i


End Sub

 

[Legacy 436357]

It is working with that latest code thanks. I did some trials and what it does now it will pull all November's lines (checking the date) which is great. Is there a way to check to see if those lines were already posted so there aren't duplicates? Maybe it's too much to ask sorry if that is the case. I do appreciate the help.

 

[mole999]

It is working with that latest code thanks. I did some trials and what it does now it will pull all November's lines (checking the date) which is great. Is there a way to check to see if those lines were already posted so there aren't duplicates? Maybe it's too much to ask sorry if that is the case. I do appreciate the help.

probably better to pull all the right data, then delete the new duplicates, rather than complex checks

 

[Legacy 436357]

I agree thank you very much for the help. Is there a way to say this is solved?

 

[lrobbo314]

This code will copy everything over and then remove duplicates at the end. Let me know if it works for you.

Sub CopyNovember()


Dim wsMain  As Worksheet: Set wsMain = Sheets("Equipment") 
Dim wsNov   As Worksheet: Set wsNov = Sheets("November")
Dim AR()    As Variant: AR = wsMain.Range("A3").CurrentRegion.Value
Dim LR      As Long
Dim R       As Range


For i = 2 To UBound(AR)
    If IsDate(AR(i, 1)) Then
        If Month(AR(i, 1)) = 11 Then
            LR = wsNov.Range("A" & Rows.Count).End(xlUp).Row() + 1
            Set R = wsNov.Range("A" & LR).Resize(1, UBound(AR, 2))
            tmp = Application.Index(AR, i, 0)
            R.Value = tmp
        End If
    End If
Next i


Set R = wsNov.Range("A3").CurrentRegion
R.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes


End Sub

 

[Legacy 436357]

Wow that's fantastic! Thank you so much for the great help. How does it check for November dates only? Just curious...

 

[mole999]

its set in the code for November and also month = 11