Page 2 of 2 FirstFirst 12
Results 16 to 23 of 23
  1. #16
    5 Star Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,194
    Thanks
    44
    Thanked 226 Times in 210 Posts
    Very simple resolution. In the code for the new form, change the 7 to a 9:
    emptyRow = .Cells(1, 9).End(xlDown).Row + 1

    You must select a column that counts down from row 2. Column 9-23 in the data sheet has a value in row 2 so changing the column to any of those will resolve your issue. If you look on the other data sheet, I chose 7 because it has a value in row 2 where the others are merged. If you were not using merged cells in the header row, any header column would be acceptable as long as it has a header value.

    Maud

  2. The Following User Says Thank You to Maudibe For This Useful Post:

    scubajay30 (2014-09-18)

  3. #17
    New Lounger
    Join Date
    Jun 2014
    Posts
    20
    Thanks
    9
    Thanked 0 Times in 0 Posts
    Utilities Route working.xlsm

    OK I am back with another issue and hopefully you can help. I have recently lost the ability to use Outlook to email the report on a daily basis. SO the only way I can efficiently do this is come up with a script that when they are finish with the route it will take all of the data on sheets 2, 3, and 4 and insert it in another workbook. It would be nice if when the script pastes the dat it uses something like a lastcell or some other way of finding the first blank row so I can keep compiling the data in one sheet. I was wondering if you might lead me in the right direction as I have no idea where to even start. I know this is a lot to ask but if you just get me started I may be able to figure out the rest. Attached is what I have so far.

  4. #18
    5 Star Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,194
    Thanks
    44
    Thanked 226 Times in 210 Posts
    Scubajay,

    Here is the code that should do what you want. Clicking on the Transfer button will open the destination workbook and transfer each row from sheets 2 through 4 in the source file to corresponding sheets in the destination file. The newly added rows in the destination file will be appended to any existing rows. Lastly, the macro will save and close the destination file with no user intervention.

    You will need to change Path to the path of your destination file. It does not matter if the destination file is open or closed when the routine is initiated but either way, it will close and save upon completion. I have left some test data in the attached sample to play with

    HTH,
    Maud

    Code:
    Sub Transfer()
    On Error Resume Next
    '---------------------------------------------
    'DECLARE OBJECTS/VARIABLES
        Dim Targetbook As Workbook
        Dim Sourcebook As Workbook
        Dim Path
    '---------------------------------------------
    'OPEN TARGET WORKBOOK AND SET VARIABLE TO WORKBOOKS
        Path = "C:\Users\Maudibe\Desktop\"
        Workbooks.Open Filename:=Path & "Utilities DB.xlsx"
        Set Targetbook = Workbooks("Utilities DB.xlsx")
        Set Sourcebook = Workbooks("Utilities Route working.xlsm")
    '---------------------------------------------
    'CYCLE THROUG SHEETS IN EACH WORKBOOK AND COPY DATA
    For I = 2 To 4
        LastRow = Sourcebook.Worksheets(I).Cells(Rows.Count, 2).End(xlUp).Row
        EndRow = Targetbook.Worksheets(I - 1).Cells(Rows.Count, 2).End(xlUp).Row
        LastRow = IIf(LastRow < 2, 2, LastRow)
        EndRow = IIf(EndRow < 2, 2, EndRow)
        Select Case I
            Case 2: col = 24
            Case 3: col = 27
            Case 4: col = 4
        End Select
        For J = 3 To LastRow
            For K = 1 To col
                Targetbook.Worksheets(I - 1).Cells(EndRow + 1, K) = Sourcebook.Worksheets(I).Cells(J, K)
            Next K
            EndRow = EndRow + 1
        Next J
    Next I
    '--------------------------------------------
    'SAVE AND CLOSE TARGET WORKBOOK
    Application.DisplayAlerts = False
    Targetbook.Close savechanges:=True
    Application.DisplayAlerts = True
    End Sub
    Attached Files Attached Files
    Last edited by Maudibe; 2014-07-15 at 22:25.

  5. The Following User Says Thank You to Maudibe For This Useful Post:

    scubajay30 (2014-09-18)

  6. #19
    New Lounger
    Join Date
    Jun 2014
    Posts
    20
    Thanks
    9
    Thanked 0 Times in 0 Posts
    WOW! once again you have amazed me!

    I will buy you a beer if you can tell me how to make it check the target for duplicates before it inserts the data. Would I use a IF statement or is there a better way?

  7. #20
    5 Star Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,194
    Thanks
    44
    Thanked 226 Times in 210 Posts
    Scubajay,

    I think this should do the trick.....Heineken!

    Code:
    Sub Transfer()
    On Error Resume Next
    '---------------------------------------------
    'DECLARE OBJECTS/VARIABLES
        Dim Targetbook As Workbook
        Dim Sourcebook As Workbook
        Dim Path
    '---------------------------------------------
    'OPEN TARGET WORKBOOK AND SET VARIABLE TO WORKBOOKS
        Path = "C:\Users\Maudibe\Desktop\"
        Workbooks.Open Filename:=Path & "Utilities DB.xlsx"
        Set Targetbook = Workbooks("Utilities DB.xlsx")
        Set Sourcebook = Workbooks("Utilities Route working.xlsm")
    '---------------------------------------------
    'CYCLE THROUG SHEETS IN EACH WORKBOOK AND COPY DATA
    For I = 2 To 4
        LastRow = Sourcebook.Worksheets(I).Cells(Rows.Count, 2).End(xlUp).Row
        EndRow = Targetbook.Worksheets(I - 1).Cells(Rows.Count, 2).End(xlUp).Row
        LastRow = IIf(LastRow < 2, 2, LastRow)
        EndRow = IIf(EndRow < 2, 2, EndRow)
    '---------------------------------------------
    'DETERMINE NUMBER OF COLUMNS ON SHEET
        Select Case I
            Case 2: col = 24
            Case 3: col = 27
            Case 4: col = 4
        End Select
    '---------------------------------------------
    'CYCLE THROUGH ROWS ON SHEETS
        For J = 3 To LastRow
        '---------------------------------------------
        'CHECK FOR DUPLICATES
            For M = 3 To EndRow
                If Sourcebook.Worksheets(I).Cells(J, 2) = Targetbook.Worksheets(I - 1).Cells(M, 2) Then GoTo NextAsset
            Next M
        '---------------------------------------------
        'COPY ASSET TO TARGET SHEET
            For K = 1 To col
                Targetbook.Worksheets(I - 1).Cells(EndRow + 1, K) = Sourcebook.Worksheets(I).Cells(J, K)
            Next K
            EndRow = EndRow + 1
    NextAsset:
        Next J
    Next I
    '--------------------------------------------
    'SAVE AND CLOSE TARGET WORKBOOK
    Application.DisplayAlerts = False
    Targetbook.Close savechanges:=True
    Application.DisplayAlerts = True
    End Sub

  8. The Following User Says Thank You to Maudibe For This Useful Post:

    scubajay30 (2014-09-18)

  9. #21
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,160
    Thanks
    200
    Thanked 781 Times in 715 Posts
    Maud,

    Just a thought.

    How about replacing this:
    Code:
        'CHECK FOR DUPLICATES
            For M = 3 To EndRow
                If Sourcebook.Worksheets(I).Cells(J, 2) = Targetbook.Worksheets(I - 1).Cells(M, 2) Then GoTo NextAsset
            Next M
        '---------------------------------------------
        'COPY ASSET TO TARGET SHEET
            For K = 1 To col
                Targetbook.Worksheets(I - 1).Cells(EndRow + 1, K) = Sourcebook.Worksheets(I).Cells(J, K)
            Next K
            EndRow = EndRow + 1
    NextAsset:
    With this:
    Code:
       Dim rngResults As Range
    
       Set rngResults = Targetbook.Worksheets(I - 1).Range(Cells(3, 13), Cells(lEndRow, 13)).Find(Sourcebook.Worksheets(I).Cells(J, 2), LookIn:=xlValues)
       
       If rngResults Is Nothing Then  '*** NOT Found ***
        'COPY ASSET TO TARGET SHEET
            For K = 1 To col
                Targetbook.Worksheets(I - 1).Cells(EndRow + 1, K) = Sourcebook.Worksheets(I).Cells(J, K)
            Next K
            EndRow = EndRow + 1
       End If
    I think this code has 2 advantages:
    1. The Find should be more efficient that the loop.
    2. It gets rid of the GoTo.

    Note: I tested the concept code but I have NOT tested the integration into your code!

    HTH

    FYI: Here's my test file: TestFindCode.xlsm
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  10. The Following 2 Users Say Thank You to RetiredGeek For This Useful Post:

    Maudibe (2014-07-18),scubajay30 (2014-09-18)

  11. #22
    New Lounger
    Join Date
    Jun 2014
    Posts
    20
    Thanks
    9
    Thanked 0 Times in 0 Posts
    Well hello gentleman. Thank you for all of the help you have provided on this project. I have learned a great deal throughout this. Unfortunatly, I am back again with my hand out asking for help. I have two favors:

    1. Can you look through this program and give me any suggestions as far as funtionality (or anything really)
    2. As you can see there is a button on the start sheet that is labeled "Trends". Ideally, I would like this to call the UFTrends userform and when the user clicks one of the buttons at the bottom, (this is where it gets difficult) it looks through the asset DATA sheet and the Air Compressor DATA sheet for any records of this asset and creats a line chart with a previous data. As you will see, the buttons on the bottom of the UFTrends userform match some of the column headers on the sheets. I have started working on it but I cant get anything to populate in the chart area. I am sure I am way off course.

    P.S. the password to run "Application.visible=true" is bulldogs (click ADMIN button at top left)

    Any direction you can give me would be wonderful!!!!

    Jay
    Attached Files Attached Files

  12. #23
    New Lounger
    Join Date
    Jun 2014
    Posts
    20
    Thanks
    9
    Thanked 0 Times in 0 Posts
    I moved this to a new thread as it did not pertain to the original post. I hope this is ok.

Page 2 of 2 FirstFirst 12

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •