Results 1 to 6 of 6

Thread: code not to copy formula

  1. #1
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12

    code not to copy formula

    Hi All

    Can somebody help me with this

    i have a code in sheet 2 that when a y is entered into column m it copies that row into sheet 3
    but it also copies the formula aswell,
    In sheet 1 the data will be auto deleted when a date is reached but this would also delete the data in
    sheet 3 because its still looking at the formula, how can i get araound this?

    The data in sheet 2 is just mirrored from sheet 1 which when the data in sheet 1 is deleted would leave
    blank rows in sheet 2 is there a way around this to ??


    Any help would be appreciated

    Peter
    Attached Files Attached Files

  2. #2
    Junior Member
    Join Date
    Aug 2013
    Posts
    18
    Rep Power
    0
    Hi Peter,

    Try this which copies the range from SHEET2 to Sheet3 as values:

    Code:
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
        
        Dim ws1 As Worksheet
        Dim ws2 As Worksheet
        Dim tRow As Long
        Dim nRow As Long
        
        If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("M:M")) Is Nothing Then                  'adjust for check column
            If UCase(Target.Value) = "Y" Then
                Set ws1 = Worksheets("SHEET2")
                Set ws2 = Worksheets("Sheet3")
                tRow = Target.Row
                nRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
                Application.ScreenUpdating = False
                ws1.Range("A" & tRow).Resize(, 9).Copy
                ws2.Range("A" & nRow).PasteSpecial xlPasteValues    '(, 8) adjust for # columns to copy
                Application.CutCopyMode = False
                Set ws1 = Nothing
                Set ws2 = Nothing
                Application.ScreenUpdating = True
            End If
        End If
    
    End Sub
    HTH

    Robert

  3. #3
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12
    Thanks Robert that works great..

    Is there a way to get it so that when i put a cost in the ist service cell and copy it copies to sheet 3 and then when i enter a cost in 2nd service it will add this data or copy over the same row uning the reg as a unique number

    peter

  4. #4
    Junior Member
    Join Date
    Aug 2013
    Posts
    18
    Rep Power
    0
    Hi Peter,

    Try this:

    Code:
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
        
        Dim ws1 As Worksheet
        Dim ws2 As Worksheet
        Dim tRow As Long
        Dim nRow As Long
        
        If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("M:M")) Is Nothing Then                  'adjust for check column
            If UCase(Target.Value) = "Y" Then
                Set ws1 = Worksheets("SHEET2")
                Set ws2 = Worksheets("Sheet3")
                tRow = Target.Row
                If InStr(CStr(ws2.Name), " ") > 0 Then 'Need single quote if tab name has a space
                    On Error Resume Next 'Account for no match
                        nRow = Evaluate("MATCH(B5,'" & CStr(ws2.Name) & "'!B:B,0)")
                    On Error GoTo 0
                Else
                    On Error Resume Next 'Account for no match
                        nRow = Evaluate("MATCH(B5," & CStr(ws2.Name) & "!B:B,0)")
                    On Error GoTo 0
                End If
                If nRow = 0 Then
                    nRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
                End If
                Application.ScreenUpdating = False
                ws1.Range("A" & tRow).Resize(, 9).Copy
                ws2.Range("A" & nRow).PasteSpecial xlPasteValues    '(, 8) adjust for # columns to copy
                Application.CutCopyMode = False
                Set ws1 = Nothing
                Set ws2 = Nothing
                Application.ScreenUpdating = True
            End If
        End If
    
    End Sub
    Regards,

    Robert

  5. #5
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12
    Hi Robert

    I have attached an updated file

    i am tring to have certain cell data copied into summary sheet so that the rows can be filtered and these can be calculated to show profit/loss .

    At the moment sheet one holds the imputted data and sheet two mirrors certain cells from sheet 1
    sheet 3 copies the data from sheet 2 without the formula, so its not deleted when the rows in sheet 1 are (on the full wb there is and auto delete/cleanse
    function to delete rows 12 months after contract has ended)

    what i would like is the imput data to be copied into a sheet (like sheet4) and not have the other sheets so that it can be updated when additional costs are imputed(via the unique reg number) but not deleted when the imput row goes and i can then filter data and cost up the filteed data.

    at the moment if i use the find blank row code that is in sheet 2 for sheet 4 it enters it blow the grid (the cells are not empty)

    could the code only look at the next blank cell in column A so it would not check the other cells that have forular in them?

    Could the data be copied automatic instead of telling when by entering y, the full wb checks and updates when it is opened, or before it closes would be ok or as the data is typed

    there would also be a second shet the same as sheet 1 that would need its data copying into sheet 4

    hope i have explained this ok ??

    I have tried and failed to tweak the coding to do what i need

    If you have a better way to complete this task i would be very interested to know.
    Thank you

    Peter
    Attached Files Attached Files

  6. #6
    Junior Member
    Join Date
    Aug 2013
    Posts
    18
    Rep Power
    0
    Hi Peter,

    Try this - just not sure what you want in column G of Sheet4. As entries only with a reg number in column B of SHEET1 are copied over to to Sheet4, row 8 is ignored. I've included some notes to help show you what the code is doing.

    If this isn't right I'd suggested starting a new thread as you're original question has been answered and what you're now asking for is now totally different.

    Regards,

    Robert

    Code:
    Option Explicit
    Sub Macro1()
    
        Const lngStartRow As Long = 3 'Commencement row number for data. Change to suit.
        
        Dim lngEndRow As Long
        Dim rngCell As Range
        Dim lngMyRow As Long
        Dim ws1 As Worksheet, _
            ws2 As Worksheet
            
        Application.ScreenUpdating = False
            
        Set ws1 = Worksheets("SHEET1")
        Set ws2 = Worksheets("Sheet4")
        
        lngEndRow = ws1.Range("A:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Find the last row in ws1 from columns A to M (inclusive)
        
        For Each rngCell In ws1.Range("B" & lngStartRow & ":B" & lngEndRow)
            'If there's a reg number in column B of the current row, then...
            If Len(rngCell) > 0 Then
                On Error Resume Next
                    '...try and find if it's already been copied to Sheet4
                    lngMyRow = 0 'Initialise variable
                    'Note if the reg number becomes numeric, you'll need to remove the double quotation marks around rngCell
                    lngMyRow = Evaluate("MATCH(""" & rngCell & """," & CStr(ws2.Name) & "!B:B,0)")
                On Error GoTo 0
                'If the reg number is already in Sheet4 then...
                If lngMyRow <> 0 Then
                    '...link the data from SHEET1 to the applicable row in Sheet4
                    ws2.Range("A" & lngMyRow).Value = ws1.Range("A" & rngCell.Row).Value
                    ws2.Range("B" & lngMyRow).Value = ws1.Range("B" & rngCell.Row).Value
                    ws2.Range("C" & lngMyRow).Value = ws1.Range("E" & rngCell.Row).Value
                    ws2.Range("D" & lngMyRow).Value = ws1.Range("F" & rngCell.Row).Value
                    ws2.Range("E" & lngMyRow).Value = ws1.Range("G" & rngCell.Row).Value
                    ws2.Range("F" & lngMyRow).Value = ws1.Range("H" & rngCell.Row).Value
                    ws2.Range("H" & lngMyRow).Formula = "=D" & lngMyRow & "-E" & lngMyRow
                'Else...
                Else
                    '...find the next available row in Sheet4 and then link the data from SHEET1 to that row.
                    lngMyRow = ws2.Range("A:H").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 'Find the last row in ws2 from columns A to H (inclusive) and increment this by 1
                    ws2.Range("A" & lngMyRow).Value = ws1.Range("A" & rngCell.Row).Value
                    ws2.Range("B" & lngMyRow).Value = ws1.Range("B" & rngCell.Row).Value
                    ws2.Range("C" & lngMyRow).Value = ws1.Range("E" & rngCell.Row).Value
                    ws2.Range("D" & lngMyRow).Value = ws1.Range("F" & rngCell.Row).Value
                    ws2.Range("E" & lngMyRow).Value = ws1.Range("G" & rngCell.Row).Value
                    ws2.Range("F" & lngMyRow).Value = ws1.Range("H" & rngCell.Row).Value
                    ws2.Range("H" & lngMyRow).Formula = "=D" & lngMyRow & "-E" & lngMyRow
                End If
            End If
        Next rngCell
        
        Application.ScreenUpdating = True
    
    End Sub
    Robert

Similar Threads

  1. VBA Code To Autofill Formula In Every Nth Row
    By analyst in forum Excel Help
    Replies: 1
    Last Post: 12-23-2013, 05:51 PM
  2. Replies: 8
    Last Post: 10-31-2013, 12:38 AM
  3. Replies: 1
    Last Post: 10-16-2013, 05:06 PM
  4. VBA Code to Open Workbook and copy data
    By Howardc in forum Excel Help
    Replies: 16
    Last Post: 08-15-2012, 06:58 PM
  5. VBA code to copy data from source workbook
    By Howardc in forum Excel Help
    Replies: 1
    Last Post: 07-30-2012, 09:28 AM

Posting Permissions

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