Question for JLatham

M

Morgan

Hi J,
I responded with answers to your questions on my post titled 'could someone
write me a VB code? thanks' dated 3/4/2010. Have you had time to have a look
at it yet?
 
J

JLatham

Morgan,
Got a little busy yesterday and I didn't get a chance to do anything last
night. I see you've provided information regarding the beginning of the list
of dependencies and a sheet name. That should allow me to get going on it
again.
Might be best if we take this off-line now, Drop me an email to (remove
spaces)
Help From@ JLatham Site.com
and communication and coordination can go much smoother and faster.
 
J

JLatham

Solution found. Morgan needed to apply the same set of rules to numerous
worksheets, with a difference between them as to which columns on one sheet
would receive the results of changes in 2 cells on each of the others that
were the basis/beginning cells for a series of formulas. He was able to take
the following Workbook_SheetChange() event code and modify it to get things
to work the way he needed them to.

Code published here in case anyone needs a similar solution:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'this event fires when any user entry is made on any sheet,
'so you have to test to see if the change took place on a
'sheet that you have an interest in. We'll do that in the
'Select Case block below
'
'some variables and constants we will use for this processing
Const firstRowOfInterest = 2
Const lastRowOfInterest = 2500
Const firstColOfInterest = 10 ' column J's column number
Const lastColOfInterest = 12 ' column L's column number

'these have to do with the sheet that has cells V17/X25 on them
'that we want to copy. The sheet name can be the same as one
'of the sheet's we are testing on.
'if different sheets are to be used, you could declare this
'a variable using: Dim copyToSheetName As String
'and then assign a sheet name to it in the Select Case
'statements below much as we do other variables at this time.
Const copyToSheetName = "Graph"

Dim doProcessFlag As Boolean ' says ready to set up individual sheets
Dim doCopyFlag As Boolean ' says ready to actually do the copy
Dim firstCellToCopy As String ' will be address as V17
Dim secondCellToCopy As String ' will be address as X25
Dim firstDestColumn As String ' will be a column ID as A
Dim secondDestColumn As String ' will be a column ID as K

If Target.Cells.Count > 1 Or IsEmpty(Target) Then
'either more than one cell got changed (as with [Del], or
'just the one cell got [Del] action, do nothing
Exit Sub
End If
'now test to see if the cell that changed was
'within the J2:L2500 area on the sheet
If Target.Row < firstRowOfInterest Or _
Target.Row > lastRowOfInterest Or _
Target.Column < firstColOfInterest Or _
Target.Column > lastColOfInterest Then
'not within the J2:L2500 area, don't do anything
Exit Sub
End If
'
'if we get here then we know that
'it was within the range, now the question is
' Was it on a sheet we are interested in??
'
doProcessFlag = False ' initialize to false condition
Select Case Sh.Name ' test the name of the sheet
Case Is = "Level One 25"
doProcessFlag = True ' so we process at the end of this
'set up to copy cell V17 on the active sheet
'into column A on the "Graph" sheet
firstCellToCopy = "V17"
firstDestColumn = "A"
'set up to copy cell X25 on the active sheet
'into column K on the "Graph" sheet
secondCellToCopy = "X25"
secondDestColumn = "K"
'this is a sheet of interest
'so set the 'doProcessFlag' = True
'you can set up a single Case Is = statement to test
'several sheets, as:
' Case Is = "Level One 25", "Level Two 25", "Level One 26"
'or you can handle each separately as:
'advantage of handling each separately is that
'you can set the copy from and copy to cells/columns
'individually for each sheet as shown for real above.
' Case Is = "Level One 25"
'set up to copy cell V17 on the active sheet
'into column A on the "Graph" sheet
'firstCellToCopy = "V17"
'firstDestColumn = "A"
'set up to copy cell X25 on the active sheet
'into column K on the "Graph" sheet
'secondCellToCopy = "X25"
'secondDestColumn = "K"
' doProcessFlag = True ' so we process at the end of this
' Case Is = "Level Two 25"
'set up to copy cell U17 on the active sheet
'into column B on the "Graph" sheet
'firstCellToCopy = "U17"
'firstDestColumn = "B"
'set up to copy cell W25 on the active sheet
'into column L on the "Graph" sheet
'secondCellToCopy = "W25"
'secondDestColumn = "L"
' doProcessFlag = True ' so we process at the end of this
' Case Is = "Level One 26"
'set up to copy cell T17 on the active sheet
'into column C on the "Graph" sheet
'firstCellToCopy = "T17"
'firstDestColumn = "C"
'set up to copy cell Z25 on the active sheet
'into column M on the "Graph" sheet
'secondCellToCopy = "Z25"
'secondDestColumn = "M"
' doProcessFlag = True ' so we process at the end of this
'
'while not required, it's always good practice to handle
'the "Case Else" condition, so we will
Case Else
'do nothing, doProcessFlag is already false
End Select

If doProcessFlag Then
'it was on a sheet we must deal with
'set up to re-enable event processing in the case of an error
On Error GoTo ExitSheetChangeTests
Application.EnableEvents = False ' to prevent re-entry to this process

'****
' this will copy V17 and X25 to the Graph sheet for each
' individual change in J2:L2500, so you could end up with
' 3 duplicate entries
'****
'copy the entry in V17 on the sheet to the 'Graph' sheet at the
'bottom of column A
ThisWorkbook.Worksheets(copyToSheetName).Range(firstDestColumn & _
Rows.Count).End(xlUp).Offset(1, 0) = Sh.Range(firstCellToCopy)
'this is just for info to show you how it works on the Graph sheet
ThisWorkbook.Worksheets(copyToSheetName).Range(firstDestColumn & _
Rows.Count).End(xlUp).Offset(0, 1) = "From single cell Change"

'copy the entry in X17 on the sheet to the 'Graph' sheet at the
'bottom of column K
ThisWorkbook.Worksheets(copyToSheetName).Range(secondDestColumn & _
Rows.Count).End(xlUp).Offset(1, 0) = Sh.Range(secondCellToCopy)
'this is just for info to show you how it works on the Graph sheet
ThisWorkbook.Worksheets(copyToSheetName).Range(secondDestColumn & _
Rows.Count).End(xlUp).Offset(0, 1) = "From single cell Change"
'
'****
'****
'this will not copy V17 or X25 until all 3 cells in a row in columns
'J, K or L on the sheet have values in them
'****
'****
doCopyFlag = False
Select Case Target.Column
Case Is = 10 ' in J, check K and L
If Not IsEmpty(Target.Offset(0, 1)) And _
Not IsEmpty(Target.Offset(0, 2)) Then
doCopyFlag = True
End If
Case Is = 11 ' in K, check J and L
If Not IsEmpty(Target.Offset(0, -1)) And _
Not IsEmpty(Target.Offset(0, 1)) Then
doCopyFlag = True
End If
Case Else
'must be in column L, check J and K
If Not IsEmpty(Target.Offset(0, -2)) And _
Not IsEmpty(Target.Offset(0, -1)) Then
doCopyFlag = True
End If
End Select

If doCopyFlag Then
'copy the entry in V17 on the sheet to the 'Graph' sheet at the
'bottom of column A
ThisWorkbook.Worksheets(copyToSheetName).Range(firstDestColumn & _
Rows.Count).End(xlUp).Offset(1, 0) = Sh.Range(firstCellToCopy)
'this is just for info to show you how it works on the Graph sheet
ThisWorkbook.Worksheets(copyToSheetName).Range(firstDestColumn & _
Rows.Count).End(xlUp).Offset(0, 1) = "All 3 cells have a value in
them"


'copy the entry in X25 on the sheet to the 'Graph' sheet at the
'bottom of column K
ThisWorkbook.Worksheets(copyToSheetName).Range(secondDestColumn & _
Rows.Count).End(xlUp).Offset(1, 0) = Sh.Range(secondCellToCopy)
'this is just for info to show you how it works on the Graph sheet
ThisWorkbook.Worksheets(copyToSheetName).Range(secondDestColumn & _
Rows.Count).End(xlUp).Offset(0, 1) = "All 3 cells have a value in
them"

End If
'****
'****
'end of section that does copying only when all 3 cells on a
'row have some non-blank entry in them
'****
'****
End If
ExitSheetChangeTests:
If Err <> 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
Application.EnableEvents = True ' re-enable normal processing
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top