Report

Criteria dependent data transfer.

Ask a question SFRIAR616 6Posts Friday September 15, 2017Registration date November 14, 2017 Last seen - Last answered on Sep 19, 2017 at 09:14 AM by vcoolio
Good Morning,
I would really appreciate some assistance with regards to a workbook I am creating in Excel 2010 to track equipment movements.
I have created several spreadsheets within a workbook titled as follows - Equipment Register; Available Equipment & Quarantined Equipment. What I would like to do is to be able to automatically transfer the data for each piece of equipment listed in the 1st sheet dependant on its status (ie if status is stock move into the Available Equipment Sheet and if quarantined move to the quarantined sheet).
Any assistance would be greatly appreciated.
Thank you.
Helpful
+1
plus moins
Hello SFRIAR616,

You say that you have several sheets within your workbook. Could you name them all for us please and also advise which status you use for each sheet.

Thank you.

Cheerio,
vcoolio.
Was this answer helpful?  
SFRIAR616 6Posts Friday September 15, 2017Registration date November 14, 2017 Last seen - Sep 15, 2017 at 09:38 AM
Hi Vcoolio,

I am trying to create a work book in Excel 2010 to track survey equipment movements within the company.
Currently I have the following named sheets in the workbook:
Sheet 1 - Equipment Register (set up as a table)
Sheet 2 - Available Equipment (list of equipment from sheet 1 currently "in stock"
Sheet 3 - Quarantined Equipment (list of equipment from sheet 1 requiring "calibration" or "repair"

What I would like to do is automatically copy all rows from sheet 1 to either sheet 2 or sheet 3 depending on the equipment status ie. "stock", "awaiting calibration" or "awaiting repair"
Sheet 1 has headings from A1-I1 with my criteria column H. What I would like to be able to do is copy the data from columns A-G in sheet 1 to the corresponding work sheet.

I would really appreciate any assistance you could give as I have no experience in VBA code.

Thanks
Reply
Leave a comment
Helpful
+1
plus moins
Hello SFriar616,

Based on what you have described, try the following code in a copy of your work book:-
Option Explicit

Sub MoveStuff()

Dim ar As Variant, i As Integer, ws As Worksheet

ar = [{"Available Equipment","Quarantined Equipment(C)","Quarantined Equipment(R)";"Stock","Calibration","Repair"}]

Application.ScreenUpdating = False

Set ws = Sheet1

    For i = 1 To UBound(ar, 2)
           Sheets(ar(1, i)).UsedRange.Offset(1).ClearContents
                With ws.Range("H1", ws.Range("H" & ws.Rows.Count).End(xlUp))
                    .AutoFilter 1, ar(2, i)
                    ws.Range("A2", ws.Range("G" & ws.Rows.Count).End(xlUp)).Copy
                     Sheets(ar(1, i)).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
                     .AutoFilter
                    Sheets(ar(1, i)).Columns.AutoFit
            End With
    Next i
   
ws.Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "All done!", vbExclamation

End Sub


I've created a little sample for you to play with at the following link:-

http://ge.tt/2GGd2Zm2

You'll notice that I have created an extra sheet named "Quarantined Equipment (R)" which is where the data for equipment designated for repair will be transferred. The data for equipment designated for calibration will be transferred to the "Quarantined Equipment (C)" sheet. This method will mean less iterations for the code to execute which, in turn, will make for a more seamless transfer of data process.

Click on the "RUN" button to see it work.

I hope that this helps.

Cheerio,
vcoolio.
Was this answer helpful?  
Leave a comment
Helpful
+1
plus moins
Hello again SFriar616,

I noticed in your post #2 that you mentioned that the data in the Equipment Register is in table format. I'm not sure if you mean that it is an actual table or a normal data set.

Just in case, following is the code adjusted to allow for an actual table format:-


Option Explicit

Sub MoveStuff()

Dim ar As Variant, i As Integer, ws As Worksheet, lr As Long

ar = [{"Available Equipment","Quarantined Equipment(C)","Quarantined Equipment(R)";"Stock","Calibration","Repair"}]

Application.ScreenUpdating = False

Set ws = Sheet1
ws.ListObjects("Table1").Unlist

    For i = 1 To UBound(ar, 2)
           Sheets(ar(1, i)).UsedRange.Offset(1).ClearContents
                With ws.Range("H1", ws.Range("H" & ws.Rows.Count).End(xlUp))
                    .AutoFilter 1, ar(2, i)
                    ws.Range("A2", ws.Range("G" & ws.Rows.Count).End(xlUp)).Copy
                     Sheets(ar(1, i)).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
                     .AutoFilter
                    Sheets(ar(1, i)).Columns.AutoFit
            End With
    Next i
   
ws.Select
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.ListObjects.Add(xlSrcRange, Range("A1:L" & lr), , xlYes).Name = "Table1"

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "All done!", vbExclamation

End Sub


Following is the link to the updated file sample:-

http://ge.tt/99VR8Zm2

The code refers to the table as "Table1". If you have a different name for it, then change "Table1" in lines 13 and 30 to whatever your table name is.

Cheerio,
vcoolio.
Was this answer helpful?  
SFRIAR616 6Posts Friday September 15, 2017Registration date November 14, 2017 Last seen - Sep 18, 2017 at 05:40 AM
Morning Vcoolio,

Thanks very much for the prompt reply.
I have tried it and it seems to be doing exactly what I want, however, it does not seem to copy all the relevant data.
I have to admit that I changed the names of the work sheets in the code and added a new one, however, I followed your criteria.
Below is a link to a copy of the spread sheet which I would appreciate if you could have a look at and perhaps give me an insight into what the problem is.

Thank you
SFriar616

http://ge.tt/5fBTDam2
Reply
Leave a comment
Helpful
+1
plus moins
Hello SFriar616,

Now having seen your file, I've made a slight adjustment to the code as follows:-

Option Explicit

Sub MoveStuff()

Dim ar As Variant, i As Integer, ws As Worksheet, lr As Long

ar = [{"AVAILABLE EQUIPMENT","EQUIPMENT FOR CALIBRATION","EQUIPMENT FOR REPAIR","PRE OP CHECKS DUE";"STOCK","CALIBRATION","REPAIR","PRE OP CHECK"}]

Application.ScreenUpdating = False

Set ws = Sheet1
lr = ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To UBound(ar, 2)
           Sheets(ar(1, i)).UsedRange.Offset(1).ClearContents
                With ws.Range("H1", ws.Range("H" & ws.Rows.Count).End(xlUp))
                    .AutoFilter 1, ar(2, i)
                    Union(ws.Range("A2:G" & lr), ws.Range("I2:I" & lr)).Copy
                     Sheets(ar(1, i)).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
                    Sheets(ar(1, i)).Columns.AutoFit
                    .AutoFilter
            End With
    Next i
   
ws.Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "All done!", vbExclamation

End Sub


Following is the link to your file with the code implemented:-

http://ge.tt/7yCsram2

In the sample file that you supplied, you had placed the code in the sheet module. The sheet module is for event type codes only. You'll note that I have placed the code in a standard module and assigned it to the button "GO". Please remove the code from the sheet module in your actual work book, place it in a standard module and assign it to a button, as per the link above.

You may also note that I have included the "Location" column in the destination sheets as I thought that it just may be handy to be able to immediately sight where the equipment is located.

Test the code in a copy of your work book first.

I hope that this helps.

Cheerio,
vcoolio.
Was this answer helpful?  
SFRIAR616 6Posts Friday September 15, 2017Registration date November 14, 2017 Last seen - Sep 19, 2017 at 05:48 AM
Good Morning,
Absolutely brilliant............thanks very much for your assistance (and patience).
It's very much appreciated

Regards,
SFriar616
Reply
Leave a comment
Helpful
+1
plus moins
Hello SFriar616,

You're welcome. I'm glad that I was able to help.

Cheerio,
vcoolio.
Was this answer helpful?  
Leave a comment

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!