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]

Could it be done with current month and only post A to I columns? I may put more columns on source sheet but don't want them to be posted on the destination sheet. Also it seems to be adding to the end of the table and not extending the table for some reason.

 

[lrobbo314]

The code below will only post to columns A to I. It will also do just the current month. Not sure what you mean by this though, "Also it seems to be adding to the end of the table and not extending the table for some reason."

*Edit I just realized what you meant by that, I'll look into it. Didn't realize it was an actual table.

Sub CopyNovember()


Dim wsMain  As Worksheet: Set wsMain = Sheets("Main") '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)) = Month(Now) Then
            LR = wsNov.Range("A" & Rows.Count).End(xlUp).Row() + 1
            Set R = wsNov.Range("A" & LR).Resize(1, 9)
            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]

It is adding the lines but not extending the table is what I mean. The formatting of the new lines is different than the lines in the table.

 

[lrobbo314]

I don't know about the table issue. I turned the table on the November sheet to a table object, and in my test workbook, it is extending the table.

 

[Legacy 436357]

Now it is working as far as extending the table but it goes to debug at:

R.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes

 

[Legacy 436357]

I removed the 2 lines for checking duplicates and it works properly extending the table. I am happy with this result thank you very much.

 

[lrobbo314]

Yeah, I don't know. I'm not getting that error with the duplicates. You can always do a manual remove duplicates on your table after the code runs. Either way, glad that it is working well enough for you.