Posts by Malkier

Resolved.

Thanks Carim! That fixed it...

I'm just a bit puzzled how the original code seemed to work OK but now it isn't.

Do I need to make the paste destination the active cell?

Thanks again Carim - it seems the data is not being pasted by the target macros. When I select Run Macro independent of the WorksheetChange the target cells do not update?

Thanks for your help!

Thanks Carim - I have tested this and it works, so thank you! In trying to add some additional functionality it has stopped working.

I have attached the sample file.

I would like to be able to call one of two macros on worksheet change of a dropdown in cell $V$1 (I have named this range "ColumnChange"). I have attempted to do this using a Privatesub but now the original macros don't seem to be working themselves.

It now is intended to run as follows:

1. Look for change in cell value in Sheet5, based on this value run the appropriate macro (They are both identical, they just copy and paste a different range)
2. Paste the copied data as in your macro below.

Thanks in advance...

Quote from Carim

Hello,

Without your sample file ... just a blind guess ...

mainly to avoid using Select / Selection ... you could test following:

Code

Sub PasteFlows()
Dim lRow As Long
Dim c As Range
Application.ScreenUpdating = False
    lRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
        For Each c In Sheet3.Range("A1:A" & lRow)
            If c.Offset(0, 1).Value = "Test Column" Then
                With Range("Big_Column")
                    .Resize(.Rows.Count + 2, .Columns.Count).Copy
                    c.Offset(1, 7).PasteSpecial xlPasteValues
                End With
            End If
        Next c
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Display More

Hope this will help

Display More

Hi I am looking to alter code from Vcoolio the following post:

Find string match in column then paste adjacent cell

Here are the steps I am looking to execute:

1. Look for change in cell value in Sheet5 cell $V$1 (there is a dropdown in this with two options) - at this stage I have attempted make this work via a Worksheet Change
2. Look for first instance of the String "Test Column" in Column A.
3. If value of $V$1 is "Big_Column" (without quotes), Select named range "Big_Column" expand the selection by two additional rows - then copy, OR if value of $V$1 is "Small_Column" (without quotes), Select named range "Small_Column" expand the selection by two additional rows - then copy
4. Paste expanded selection 1 row down and 7 columns to the right of the 'found' string.
5. Look for next instance of "Test Column" in Column A, then repeat steps 2 and 3, till all found, then end.

Any help to get this code working would be much appreciated.

Thanks

Here is my edited code. I have only attempted to paste one of the ranges in this code but would like to do both. It could be done with two separate macros if this is cleaner, activated by the worksheet change macro.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$V$1" Then
        Call PasteFlows
    End If
End Sub

_______________________________

Sub PasteFlows()
 
 Application.ScreenUpdating = False
 
 Dim lRow As Long
 Dim fValue As String
 
 
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Sheet1.Range("A1:A" & lRow)
 fValue = "Test Column"
 If cell.Offset(0, 1).Value = fValue Then
 Range("Big_Column").Select
Selection.Resize(Selection.Rows.Count + 2, _
   Selection.Columns.Count).Select
   Selection.Copy
 cell.Offset(1, 7).PasteSpecial xlPasteValues
 End If
NextCell:
Next cell

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Re: Repeat "With" on different range not working

Thanks so much Stephen for your continued assistance.

It seems you have cleared up the "overwrite data" warning popping up unecessarily but it seems the 'For' loop is now looping through the PasteRange as intended, but returns the Else MsgBox "Plant Name not found. Please enter new plant name and region on the 'Base Data' sheet."

I know this as "Plant Name not found. Please enter new plant name and region on the 'Base Data' sheet." pops up 41 times = Offset column value for Table1
and "Plant Name not found. Please enter new plant name and region on the 'Contacts' sheet." pops up 13 times = Offset column value for Table2.

Anyway - with a little bit of juggling of the 'Exit For' and making the 'If Cell.Value <> "" Then' to 'If Cell.Value = "" Then' and putting the copy-paste straight after and doing the Else for the <> case with the popup it all worked fine.

Thanks for your help!

Sub CopyFormData()
     
    Dim varResponse As Variant
     
    varResponse = MsgBox("Are you sure want to copy data?", vbYesNo, "Confirmation")
    If varResponse <> vbYes Then Exit Sub
     
    Dim PlantName As String
    Dim PlantData As Range
    Dim ContactData As Range
    Dim BaseData As Worksheet
    Dim Contacts As Worksheet
    Dim Rng As Range
    Dim PasteRange As Range
    Dim PasteRange2 As Range
     
    PlantName = Sheets("Plant Data Entry Form").Range("G2")
    Set PlantData = Sheets("Plant Data Entry Form").Range("A31:AO31")
    Set ContactData = Sheets("Plant Data Entry Form").Range("A33:P33")
    Set SearchBase = Range("Table1[Plant Name]")
    Set SearchContacts = Range("Table2[Plant Name]")
     
    Application.ScreenUpdating = False
     
    With SearchBase
        Set Rng = .Find(What:=PlantName, _
        After:=.Cells(.Cells.Count), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
            Set PasteRange = Sheets("Base Data").Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 41))
             'If Not PasteRange Is Nothing Then
            For Each Cell In PasteRange.Cells
                If Cell.Value = "" Then
                    PlantData.Copy
                    ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)
                Else
                    ans = MsgBox("Plant already has data entered. Overwrite and update this data?", vbYesNo, "Confirmation")
                     '^--This message box comes up even if the cells are empty
                    If ans = vbYes Then
                        PlantData.Copy
                        ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)
                    End If
                End If
            Exit For
           Next
             'End If
        Else
            MsgBox "Plant Name not found. Please enter plant name and region on the 'Base Data' sheet."
        End If
    End With
     
    Set Rng = Nothing
     
    ActiveWorkbook.Sheets("Plant Data Entry Form").Activate
         
    With SearchContacts
        Set Rng = .Find(What:=PlantName, _
        After:=.Cells(.Cells.Count), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
            Set PasteRange2 = Sheets("Contacts").Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 13))
             'If Not PasteRange2 Is Nothing Then
            For Each Cell In PasteRange2.Cells
                If Cell.Value = "" Then
                    ContactData.Copy
                    ActiveCell.Offset(0, -2).PasteSpecial (xlPasteValues)
                Else
                    ans = MsgBox("This Plant already has Contact data entered. Overwrite and update this data?", vbYesNo, "Confirmation")
                     '^--This message box comes up even if the cells are empty
                    If ans = vbYes Then
                        ContactData.Copy
                        ActiveCell.Offset(0, -2).PasteSpecial (xlPasteValues)
                    End If
                End If
            Exit For
            Next
             'End If
        Else
                MsgBox "Plant Name not found. Please enter plant name and region on the 'Contacts' sheet."
        End If
    End With
     
    Application.ScreenUpdating = True
     
End Sub

Re: Repeat &quot;With&quot; on different range not working

I also get the 1004 error message:

Method 'Offste' of object 'Range' failed...

Re: Repeat &quot;With&quot; on different range not working

Stephen - you were right to be confused!

That is what I meant to do. Having edited the code as above I get the "Overwrite data" message for every cell that has data in it. What would be great would be if i could modify it to trigger when it finds the first cell with data, give the warning message and then exit after that.

What I can't work out either is why the Else at the bottom did not work as required when I deleted all the data, see notes inline below:

If Not Rng Is Nothing Then
                Application.Goto Rng, True
                Set PasteRange2 = Sheets("Contacts").Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 13))
                If Not PasteRange2 Is Nothing Then
'I thought the above If statement corresponds to the Else below...
                        For Each Cell In PasteRange2.Cells
                             If Cell.Value <> "" Then
                                ans = MsgBox("Plant/organisation already has contact data entered. Overwrite and update this data?", vbYesNo, "Confirmation")
                                If ans = vbYes Then
                                    ContactData.Copy
                                    ActiveCell.Offset(0, -2).PasteSpecial (xlPasteValues)
                            End If
            Else
                MsgBox "Plant Name not found. Please enter new plant name and region on the 'Contacts' sheet."
'When I deleted the plant name from the tables accidentally this error message did not show...
            End If

Re: Repeat &quot;With&quot; on different range not working

Stephen - I managed to get the second block to work. The code relies on the user having entered a plant name and I had deleted it in testing...

Having said that it highlights that the code I have to pop up a message when no plant name is entered is not working, nor is it properly detecting non-blank cells. Even when there is no data it gives the message box "Plant/organisation already has contact data entered. Overwrite and update this data?".

Any ideas?!

Thanks for your help...

Re: Repeat &quot;With&quot; on different range not working

forum.ozgrid.com/index.php?attachment/58883/

hope it makes sense...

Re: Repeat &quot;With&quot; on different range not working

Quote from StephenR;701650

Is it PasteRange or Pasterange2?

PasteRange works ok for the first block - PasteRange2 is the in the second block that does not work. Incidentally I have cut the second block out into it's own module to try and see if the problem was following behind the first block but it still does not work.

Re: Repeat &quot;With&quot; on different range not working

Quote from StephenR;701647

What does "not so good" mean?

One thing I notice is that you are using the same variable in both blocks - Rng. If it is found in the first block, but not the second, it will behave as if it has been found because you are not resetting it to Nothing.

Not so good means that the cells do not copy at all for the second range. Is the Rng variable causing the trouble?

Hi,

I am trying to write one of my first macros. I have successfully written a macro to copy one horizontal range from one sheet to a structured table on another when a match is found in a specific column of the strucutred table. I am trying to then repeat the process, copying a different horizontal range (on the same sheet as the first) to a different sheet also containing a structured table. The code is the same for each step - only the ranges are different.

The first part of the code fires fine - the second not so good.

The other issue I am having is that I have a message box set to fire when data in the target cells may be overwritten - but it is popping up even when the target cells are blank.

Here is a link to the full problem in another forum where I am not getting much help - http://www.excelforum.com/exce…ther-sheets-on-match.html

Here is the code with the problems identified.

Any help is much appreciated...

Sub CopyFormData()


Dim varResponse As Variant
     
varResponse = MsgBox("Are you sure want to copy data?", vbYesNo, "Confirmation")
If varResponse <> vbYes Then Exit Sub


Dim PlantName As String
Dim PlantData As Range
Dim ContactData As Range
Dim BaseData As Worksheet
Dim Contacts As Worksheet
Dim Rng As Range
Dim PasteRange As Range
Dim PasteRange2 As Range


PlantName = Sheets("Plant Data Entry Form").Range("G2")
Set PlantData = Sheets("Plant Data Entry Form").Range("A31:AO31")
Set ContactData = Sheets("Plant Data Entry Form").Range("A33:N33")
Set SearchBase = Range("Table1[Plant Name]")
Set SearchContacts = Range("Table2[Plant Name]")


Application.ScreenUpdating = False


With SearchBase
        Set Rng = .Find(What:=PlantName, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                Set PasteRange = Sheets("Base Data").Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 41))
                If Not PasteRange Is Nothing Then
                        For Each Cell In Rng.Cells
                             If Cell.Value <> "" Then   
                             ans = MsgBox("Plant already has data entered. Overwrite and update this data?", vbYesNo, "Confirmation")                                  
'^--This message box comes up even if the cells are empty
                                If ans = vbYes Then
                                    PlantData.Copy
                                    ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)
                            End If
            Else
                MsgBox "Plant Name not found. Please enter new plant name and region on the 'Base Data' sheet."
            End If
        Next
    End If


End If
End With


ActiveWorkbook.Sheets("Plant Data Entry Form").Activate


'<-- the code from here on does not work but is exactly the same as above...


With SearchContacts                                   
        Set Rng = .Find(What:=PlantName, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                Set PasteRange2 = Sheets("Contacts").Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 13))
                If Not PasteRange Is Nothing Then
                        For Each Cell In Rng.Cells
                             If Cell.Value <> "" Then
                                ans = MsgBox("Plant/organisation already has contact data entered. Overwrite and update this data?", vbYesNo, "Confirmation")
                                If ans = vbYes Then
                                    ContactData.Copy
                                    ActiveCell.Offset(0, -2).PasteSpecial (xlPasteValues)
                            End If
            Else
                MsgBox "Plant Name not found. Please enter new plant name and region on the 'Contacts' sheet."
            End If
        Next
    End If


End If
End With


Application.ScreenUpdating = True


End Sub

Re: Append data from multiple sheets into master sheet

I have received a reply here...

http://www.excelforum.com/exce…er-sheet.html#post3515672

Re: Have data from Multiple sheets automatically go to a master sheet

Hi Just trying to make this code below work - do I just have to post it in the Class Module?

My case is very similar but not exactly the same - see attached example. Thanks...

forum.ozgrid.com/index.php?attachment/58032/

Quote from cytop;681140

Different approach.

This updates the Master Sheet as each cell is edited on any yearly sheet. Will cope with yearly sheets being added/removed without changes.

2 main restrictions:

• The user cannot select a bunch of cells and update them all at the same time. That will require a little additional code.
• The Proposal number must be entered before any other information on a row.

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
     
    Dim r As Excel.Range
    Dim lngRow As Long
     
    On Error GoTo ErrHandler
     
     '// If the Master sheet is being updated then exit
    If StrConv(Sh.Name, vbUpperCase) = "MASTER SHEET" Then Exit Sub
     
     '// Ignore edits outdide the 'grid'
    If Target.Column > 11 Then Exit Sub
     
     '// Multiple cells edited. Needs further development to accommodate
    If Target.Cells.Count <> 1 Then
         '// Reverse edit here?
         '// Application.Undo
        Exit Sub
    End If
     
     '// If any column except Col 1 changed, but Col 1 is still blank
     '// then warn and cancel edit. Reason is Col 1 is used as the identifier
     '// and must exist before any other details entered
    If Target.Column <> 1 And Sh.Cells(Target.Row, 1).Value = vbNullString Then
        MsgBox "Please enter the Proposal number first - Edit cancelled.", vbExclamation, "Invalid"
        With Application
             
             '// Turn off events in case the previous value was also invalid.
             '// It'll go into an endless loop otherwise
            .EnableEvents = False
            .Undo
            .EnableEvents = True
        End With
         
        Exit Sub
         
    End If
     
    Application.EnableEvents = False
     
     '// go find the Proposal on Master sheet
    Set r = Sheet1.Columns("A:A").Find(What:=Sh.Cells(Target.Row, 1).Value, Lookat:=xlWhole, MatchCase:=False)
     
    If r Is Nothing Then
         '// If not found, then use the last used row +1 for input
        lngRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
    Else
         '// Is found, set a reference to the row
        lngRow = r.Row
    End If
     
     '// And simply update the cell at Row/Column with the
     '// value of the changed cell
    Sheet1.Cells(lngRow, Target.Column).Value = Target.Value
     
     '// make sure the Project number entered
    If Sheet1.Cells(lngRow, 1).Value <> Sh.Cells(Target.Row, 1).Value Then
        Sheet1.Cells(lngRow, 1).Value = Sh.Cells(Target.Row, 1).Value
    End If
     
    Set r = Nothing
     
ErrHandler:
     
    Application.EnableEvents = True
     
    If Err.Number <> 0 Then
        MsgBox "ERROR: " & Err.Description & vbCrLf & "while updating Master Sheet." & vbCrLf & vbCrLf & "Please re-do the last edit.", vbExclamation, "Error"
    End If
     
End Sub

Display More

The code goes in the ThisWorkBook class module.

Revised copy of the workbook attached if you want to try it out.

Display More

Hi,

I have two excel files:

-Workbook1: Rows of data on Monthly sheets, currently................. I want: to dynamically display data from all sheets in a 'master sheet' in the same workbook (ie the master always shows up-to-date data).
-Workbook2: Has formula that will search the master sheet in the above workbook and return all rows that match a set criteria.

Question I would like solved is: How can I append data from the sheets in Workbook1 into one sheet? All data will have the same column headings but each sheet may have anywhere from 0-150, or more, rows of data. Ideally I would like not to have to open workbook1, to allow the master to update, for the formula in workbook2 to return a full and complete list.

I would prefer a formula (that I can understand and perhaps use again) rather than VBA code but if someone can meet the above requirements with VBA then I might be swayed.

Thanks in advance...