Add data from one sheet to another if value is met

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Add data from one sheet to another if value is met

Post by HansV »

The code will check for each of the cells that you specify whether it has changed.

Note: You should try to indent code consistently: the End If should start at the same position from the left margin as the If it belongs to; code between If and End If should be indented one tab stop further. See the code that I posted.
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Add data from one sheet to another if value is met

Post by ABabeNChrist »

Thank You HansV
Yeah I agree I need to work on that
It does make it easier to read and understand when its layout correctly

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Add data from one sheet to another if value is met

Post by ABabeNChrist »

Hi HansV
This code works great, but one small problem I discovered is since I use this code for a variety of different sheets and when the value is met at each location of each sheet it is then placed on the summary page. At the present moment I have to leave a curtain amount of rows available for each sheet, just in case all values are met for that sheet.
Below is how my summary page may appear when only a few values are met for sheet/area.
Each name like Grounds, Roof, Bedroom and bathroom represents a different sheet.
I was wonder if I should hide the rows and when value is met it would then unhide that row and then insert comment. Is this possible or is there a better method.
sum.JPG
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Add data from one sheet to another if value is met

Post by HansV »

I'd delete the rows between the "headers" except for two between each pair.
Use code to insert rows and populate them as needed.
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Add data from one sheet to another if value is met

Post by ABabeNChrist »

Hi HansV
I was able to insert rows, and it seems to work OK up to this point, but if I were to retract my comment for whatever reason, the inserted row will still be there. I tried adding some other code with Else that would delete a row, but that’s a bad idea also. How do I get around this?
I also added some code that would AutoFitMergedCellRowHeight if the text was too large for cell. But of course this doesn’t seem to work as I was hoping. It seems that I would have to tab out of cell for it to take effect.
Here the code so far
Also I'm trying to learn to line up my code as you suggested

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("A4"), Target) Is Nothing Then
    Application.EnableEvents = False
    Select Case Range("A4").Value
      Case "Bad", "Ugly"
        Sheet2.Range("A2").EntireRow.Insert
        Sheet2.Range("A2").Value = Range("A6").Value
      Case Else
        Sheet2.Range("A2").EntireRow.Delete
        Sheet2.Range("A2").Value = ""
    End Select
    Application.EnableEvents = True
  End If
    If Not Intersect(Range("A10"), Target) Is Nothing Then
    Application.EnableEvents = False
    Select Case Range("A10").Value
      Case "Bad", "Ugly"
        Sheet2.Range("A3").EntireRow.Insert
        Sheet2.Range("A3").Value = Range("A12").Value
      Case Else
        Sheet2.Range("A3").EntireRow.Delete
        Sheet2.Range("A3").Value = ""
    End Select
    Application.EnableEvents = True
  End If
    If Not Intersect(Target, Range("A6,A12")) Is Nothing Then
        Target.Select
        AutoFitMergedCellRowHeight
    End If

  End Sub

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Add data from one sheet to another if value is met

Post by ABabeNChrist »

Hi HansV
I could seem to get the insert row to work correctly
I did how ever played around with hiding the rows using

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("A4"), Target) Is Nothing Then
    Application.EnableEvents = False
    Select Case Range("A4").Value
      Case "Bad", "Ugly"
        Sheet2.Rows("2").EntireRow.Hidden = False
        Sheet2.Range("A2").Value = Range("A6").Value
      Case Else
        Sheet2.Rows("2").EntireRow.Hidden = True
        Sheet2.Range("A2").Value = ""
    End Select
    Application.EnableEvents = True
  End If
    If Not Intersect(Range("A10"), Target) Is Nothing Then
    Application.EnableEvents = False
    Select Case Range("A10").Value
      Case "Bad", "Ugly"
        Sheet2.Rows("3").EntireRow.Hidden = False
        Sheet2.Range("A3").Value = Range("A12").Value
      Case Else
        Sheet2.Rows("3").EntireRow.Hidden = True
        Sheet2.Range("A3").Value = ""
    End Select
    Application.EnableEvents = True
  End If
    If Not Intersect(Target, Range("A6,A12")) Is Nothing Then
        Target.Select
        AutoFitMergedCellRowHeight
    End If

  End Sub
It seems to work good, is there a reason you prefered inserting a row over hiding a row.

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Add data from one sheet to another if value is met

Post by HansV »

If hiding and unhiding works OK for you, I'd go with it.
But keep in mind that the hidden rows will still be there, so if there's something in those rows that you don't want the user to see, you could have a problem.
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Add data from one sheet to another if value is met

Post by ABabeNChrist »

Hi HansV
I like the way the hide and hide method works, it serves its purpose, plus there’s no information in those cells anyway.
As you may have noticed I added this to the code because of Worksheet_Change

Code: Select all

    If Not Intersect(Target, Range("A7")) Is Nothing Then
        Target.Select
        AutoFitMergedCellRowHeight
    End If
End Sub
I also have this same code in place on the target “Summary” but will not run, even though the source “Sheet1” is , is there something I can change that will run this code, should I apply with the existing after

Code: Select all

Sheets("Summary").Range("F6").Value = Range("H20").Value
From Sheet1
Last edited by ABabeNChrist on 11 Mar 2010, 23:29, edited 1 time in total.

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Add data from one sheet to another if value is met

Post by HansV »

I don't know what AutoFitMergedCellRowHeight is - is it a macro? It's not a built-in feature.
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Add data from one sheet to another if value is met

Post by ABabeNChrist »

Yes it is a macro , it works quite well

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Use the Range to select desired cells
    If Not Intersect(Target, Range("A7")) Is Nothing Then
        Target.Select
        AutoFitMergedCellRowHeight
    End If
End Sub

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Add data from one sheet to another if value is met

Post by HansV »

That is more or less the same code you had already posted.

What is the code of AutoFitMergedCellRowHeight?
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Add data from one sheet to another if value is met

Post by ABabeNChrist »

HansV wrote:That is more or less the same code you had already posted.

What is the code of AutoFitMergedCellRowHeight?
Here is the other portion that goes inside a module

Code: Select all

Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = PossNewRowHeight
End If
End With
End If
End Sub
It works the same as AutoRowHeight but with merged cells. Once data has gone beyond the size of the cell that it’s in, it will auto heighten the size of cell / row to accommodate.

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Add data from one sheet to another if value is met

Post by HansV »

1. It would be best to avoid using merged cells.
2. You should try to indent your code consistently (I've mentioned this before). Properly indented code is much easier to read and understand.
3. If you absolutely MUST use merged cells, replace the code for AutoFitMergedCellRowHeight with the following:

Code: Select all

Sub AutoFitMergedCellRowHeight()
  AFMCRH Selection
End Sub

Sub AFMCRH(rng As Range)
  Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
  Dim CurrCell As Range
  Dim ActiveCellWidth As Single, PossNewRowHeight As Single
  If rng.MergeCells Then
    With rng.MergeArea
      If .Rows.Count = 1 And .WrapText = True Then
        Application.ScreenUpdating = False
        CurrentRowHeight = .RowHeight
        ActiveCellWidth = .Cells(1).ColumnWidth
        For Each CurrCell In Selection
          MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
        Next CurrCell
        .MergeCells = False
        .Cells(1).ColumnWidth = MergedCellRgWidth
        .EntireRow.AutoFit
        PossNewRowHeight = .RowHeight
        .Cells(1).ColumnWidth = ActiveCellWidth
        .MergeCells = True
        .RowHeight = PossNewRowHeight
      End If
    End With
  End If
End Sub
Change the Worksheet_Change code to

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  If Not Intersect(Target, Range("A7")) Is Nothing Then
    AFMCRH Range("A7")
  End If
End Sub
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Add data from one sheet to another if value is met

Post by ABabeNChrist »

Thank you HansV
Once More, you are always so very helpful
I 100% agree with you about indenting my code, I have been trying this practice, but in my defense this last code was a copy and paste.
Also I do have to confess I like the way I can manipulate a sheet using merged cells. I’ve heard some horror stories; I believe there is a way around just about anything. If you where to see one of my workbooks its nothing but merged cells, it took a lot of tweaking and twisting to get it to work the way I attended. And for the most part it operates better than I hoped for.

User avatar
VegasNath
5StarLounger
Posts: 1185
Joined: 24 Jan 2010, 12:02
Location: Wales, UK.

Re: Add data from one sheet to another if value is met

Post by VegasNath »

ABabeNChrist wrote:Thank you HansV
If you where to see one of my workbooks its nothing but merged cells, it took a lot of tweaking and twisting to get it to work the way I attended.
In my early days of working in Excel, I used merged cells a lot. One thing that I have learned since meeting VBA is to avoid them like the plague! Now I rarely ever use them.
:wales: Nathan :uk:
There's no place like home.....