Posts by Malkier
-
-
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:
- 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)
- Paste the copied data as in your macro below.
Thanks in advance...
Hello,
Without your sample file ... just a blind guess ...
mainly to avoid using Select / Selection ... you could test following:
Code
Display MoreSub 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
Hope this will help
-
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:
- 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
- Look for first instance of the String "Test Column" in Column A.
- 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
- Paste expanded selection 1 row down and 7 columns to the right of the 'found' string.
- 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.
Code
Display MorePrivate 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!
Code
Display MoreSub 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 "With" on different range not working
I also get the 1004 error message:
Method 'Offste' of object 'Range' failed...
-
Re: Repeat "With" 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:
Code
Display MoreIf 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 "With" 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 "With" on different range not working
forum.ozgrid.com/index.php?attachment/58883/
hope it makes sense...
-
Re: Repeat "With" on different range not working
Quote from StephenR;701650Is 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 "With" on different range not working
Quote from StephenR;701647What 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...
Code
Display MoreSub 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...
-
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;681140Different 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
Display MorePrivate 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
The code goes in the ThisWorkBook class module.
Revised copy of the workbook attached if you want to try it out.
-
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...