PDA

View Full Version : If no dependents msgbox and resume loop



gtrdude485
06-19-2008, 05:23 PM
I have been working on a macro which examines column A in a sheet ("Tickmarks") and does the following:
1. Examines the cell in Column A for a non-blank cell
2. If the cell is non-blank, traces the dependents; Else next line
3. If there are no dependents, return an error message; Click OK
4. Move to next line

The error message is just temporary until i can make sure the loop is working properly. However, the code I have right now I don't think detects any errors because the error message doesn't generate. Any input would be appreciated. Sample attached.

Thanks.


' Trace&Replace_Dependents Macro
' Traces and replaces unused Dependents for Tickmark Sheet
'
Sub Trace_Replace_Dependents_Tickmark_Sheet()

Dim sh As Worksheet
Dim tmSheetIndex As Integer, RowCounter As Integer
RowCounter = 3

For Each sh In Worksheets
If sh.Name = "Tickmarks" Then tmSheetIndex = sh.Index
Next sh

Do
'If cell in column A is not blank
If Not (Sheets(tmSheetIndex).Range("A" & RowCounter) = 0 Or _
Sheets(tmSheetIndex).Range("A" & RowCounter).value = vbNullString) Then

'If no dependents goto skip code
On Error GoTo skip:

'Trace first dependent
With Sheets(tmSheetIndex).Range("A" & RowCounter)
.ShowDependents
.NavigateArrow False, 1, 1
End With

'Remove trace precedents and return to tickmarks page
With ActiveCell
.ShowPrecedents
.NavigateArrow True, 1, 1
.ShowPrecedents (True)

'writes if t/m is attached and updates RowCounter
Sheets(tmSheetIndex).Range("J" & RowCounter) = "This t/m is attached"
RowCounter = RowCounter + 2
End With

Else
RowCounter = RowCounter + 1

End If
Loop Until RowCounter > 23
Exit Sub

skip:
msgbox Err.Number & " " & Err.Description

End Sub

Simon Lloyd
06-20-2008, 12:48 AM
The wotkbook you supplied has no code and contains grouped rows/columns, i used this code to check through the cells in column A on the tickmark sheet and it found the contents of each cell correctly:
Sub chkit()
Dim mycell As Range, rng As Range
Set rng = Range("A2:A53")
For Each mycell In rng
If mycell.Value = 0 Or mycell.Value = vbNullString Then
MsgBox "Cell Empty" & " " & mycell.Address
ElseIf Not (Sheets("Tickmarks").Range(mycell.Address) = 0 Or _
Sheets("Tickmarks").Range(mycell.Address).Value = vbNullString) Then
MsgBox "Cell Complete" & " " & mycell.Address
End If
Next mycell
End Sub

gtrdude485
06-20-2008, 08:22 AM
I don't think I'm having trouble analyzing the column A data; I'm not getting the error message I specified in my code when there are no dependents. for each non-blank cell...

I also attached a new sheet

Ken Puls
06-20-2008, 09:34 PM
It looks like the TraceDependants and TracePrecendents commands do not trigger an error when they come up with nothing. So to check it, I set up your routine to check the name of the activesheet after you try to follow the link:

Sub Trace_Replace_Dependents_Tickmark_Sheet()

Dim sh As Worksheet
Dim tmSheetIndex As Integer, RowCounter As Integer
RowCounter = 3

For Each sh In Worksheets
If sh.Name = "Tickmarks" Then tmSheetIndex = sh.Index
Next sh

Do
'If cell in column A is not blank
If Not (Sheets(tmSheetIndex).Range("A" & RowCounter) _
= 0 Or Sheets(tmSheetIndex).Range("A" & RowCounter).Value = vbNullString) Then

'Trace first dependent
With Sheets(tmSheetIndex).Range("A" & RowCounter)
.ShowDependents
.NavigateArrow False, 1, 1
End With

'Check if still on same sheet (Means no dependents)
If ActiveSheet.Index = tmSheetIndex Then
Sheets(tmSheetIndex).Range("J" & RowCounter) = "ERROR! NOT ATTACHED!"
Else

'Remove trace precedents and return to tickmarks page
With ActiveCell
.ShowPrecedents
.NavigateArrow True, 1, 1
.ShowPrecedents (True)

'writes if t/m is attached and updates RowCounter
Sheets(tmSheetIndex).Range("J" & RowCounter) = "This t/m is attached"

End With
End If
RowCounter = RowCounter + 2
Else
RowCounter = RowCounter + 1
End If
Loop Until RowCounter > 23
End Sub

gtrdude485
06-23-2008, 11:00 AM
thanks for the help. I am onto a new section of the code now that deals with copy/pasting merged cells. I know that you are supposed to avoid merging cells at all cost, but I do not have a choice in the matter. What I want to do is eliminate all unattached tickmarks, essentially replacing non-attached tickmarks with used ones. This entails replacing the description in the merged cells but also keeping the attached tickmark's original dependents.

Example: In the attached sheet, t/m {i} is unattached but {o} is attached. I would like to replace {i}'s description with {o}, but keep the original dependent attached to {o} in it's new place as {i}.


' Trace&Replace_Dependents Macro
' Traces and replaces unused Dependents for Tickmark Sheet
'
Sub Trace_Replace_Dependents_Tickmark_Sheet()

Dim sh As Worksheet, cellAddress As String, unattached(1 To 100, 1 To 100), unattachedValues(1 To 100, 1 To 100)
Dim tmSheetIndex As Integer, RowCounter As Integer, unattachedCounter As Integer
unattachedCounter = 1
RowCounter = 3

For Each sh In Worksheets
If sh.Name = "Tickmarks" Then tmSheetIndex = sh.Index
Next sh

Do
If Not (Sheets(tmSheetIndex).Range("A" & RowCounter) = 0 Or Sheets(tmSheetIndex).Range("A" & RowCounter) = vbNullString) Then

cellAddress = Sheets(tmSheetIndex).Range("A" & RowCounter).Address

Sheets(tmSheetIndex).Range("A" & RowCounter).ShowDependents
Sheets(tmSheetIndex).Range("A" & RowCounter).NavigateArrow False, 1

If ActiveCell.Address = cellAddress Then
unattached(unattachedCounter, (unattachedCounter / unattachedCounter)) = ActiveCell.value
unattached(unattachedCounter, ((unattachedCounter / unattachedCounter) + 1)) = ActiveCell.Address
unattachedValues(unattachedCounter, (unattachedCounter / unattachedCounter)) = ActiveCell.Offset(0, 1).value
unattachedValues(unattachedCounter, (unattachedCounter / unattachedCounter + 1)) = ActiveCell.Offset(0, 1).Address

unattachedCounter = unattachedCounter + 1
End If

RowCounter = RowCounter + 1

Else
RowCounter = RowCounter + 1

End If
Loop Until RowCounter > 100

'This is

Dim range1 As Range, range2 As Range


Set range1 = Range(unattachedValues(11, 2), unattachedValues(11, 2).Offset(0, 6))
Set range1 = Range(unattachedValues(7, 2), unattachedValues(7, 2).Offset(0, 6))

Sheets(tmSheetIndex).Range(range1).Copy Destination:=Sheets(range2)

End Sub

Ken Puls
06-23-2008, 10:02 PM
Sorry, I'm not sure I follow...

Do you want Sheet1!E14 to refer to {i}?

I'm not quite sure I follow the explanation...

gtrdude485
06-27-2008, 08:38 AM
what I would like is for Sheet1!E14 to refer to Tickmarks!$A$19 AND move the cell contents of the merged cells Tickmarks!B31:H31 to Tickmarks!B19:H19. This should be done for each cell in Tickmarks!A:A with a tickmark {##} but with no attachment. I basically want to consolidate all of the tickmarks so all of the ones that are being used are moved to the beginning of the alphabet.

Ken Puls
06-27-2008, 10:10 PM
Okay, test this and see if it's what you're after. The one question I had is around the value in {i}'s note field. Should it be overwritten since no reference actually pointed to column A from the other sheet? That is what this version does:

Sub Trace_Replace_Dependents_Tickmark_Sheet()

Dim sh As Worksheet, cellAddress As String, unattached(1 To 100, 1 To 100), unattachedValues(1 To 100, 1 To 100)
Dim tmSheetIndex As Integer, RowCounter As Integer, unattachedCounter As Integer
Dim sAddressAvailable As String
unattachedCounter = 1
RowCounter = 3

For Each sh In Worksheets
If sh.Name = "Tickmarks" Then tmSheetIndex = sh.Index
Next sh

Do
If Not (Sheets(tmSheetIndex).Range("A" & RowCounter) = 0 Or Sheets(tmSheetIndex).Range("A" & RowCounter) = vbNullString) Then

cellAddress = Sheets(tmSheetIndex).Range("A" & RowCounter).Address

Sheets(tmSheetIndex).Range("A" & RowCounter).ShowDependents
Sheets(tmSheetIndex).Range("A" & RowCounter).NavigateArrow False, 1

If ActiveCell.Address = cellAddress Then
'Check if this is the first time a blank cell has been encountered
If sAddressAvailable = vbNullString Then
'Record the address
sAddressAvailable = CStr(cellAddress)
Else
'The address of the first blank cell has already been recorded
End If

Else
'Check if any blank lines have been encountered yet
If sAddressAvailable = vbNullString Then
'No blank lines encountered to date. Do Nothing.
Else
'Blank lines exist above. Move cells up to the next available line
With ActiveCell
'Adjust the reference on the audit sheet
.Formula = "=" & Sheets(tmSheetIndex).Name & "!" & sAddressAvailable
.ShowPrecedents
.NavigateArrow True, 1
End With
With Sheets(tmSheetIndex)
'Move the Tickmark notes and clear the cell currentl in use
.Range(cellAddress).Offset(0, 1).Copy
.Range(sAddressAvailable).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
.Range(cellAddress).Offset(0, 1).MergeArea.ClearContents
sAddressAvailable = .Range(sAddressAvailable).Offset(2, 0).Address
End With
End If
End If

RowCounter = RowCounter + 1

Else
RowCounter = RowCounter + 1

End If
Loop Until RowCounter > 100

End Sub

gtrdude485
07-01-2008, 09:29 AM
I'm getting an error because the Offset command is only selecting one cell but trying to paste to a range of merged cells... Any way to fix this?

Ken Puls
07-01-2008, 10:10 PM
Funny... I didn't have any issue with that...

You can try adjusting the code to include mergearea, like this:

.Range(cellAddress).Offset(0, 1).MergeArea.ClearContents

If you can't get it, is there any way you can post a sanitized copy of the workbook you are using?

gtrdude485
07-02-2008, 08:46 AM
Yea I still get the error. I understand the logic and tried to adapt the code to include the ranges instead of the cell addresses but I couldn't figure it out...

Ken Puls
07-02-2008, 09:30 PM
What version of Excel are you using? I just downloaded your example, and it ran without an error for me in Excel 2003. I've also tested it in Excel 2007 :dunno

gtrdude485
07-03-2008, 06:15 PM
hmmm... Excel 2003 I have no idea what's going on then...

The reference transfers from {o} to {i} correctly but the description in {o} ("test") is not copied and replacing the {i} description ("tickmark"). I'm not sure if that is supposed to happen but thats what I need...

Ken Puls
07-05-2008, 11:00 PM
Hmmm...

In the latest example file attached, Sheet1 E14 refers to Tickmarks A19. There is no reference on Sheet1 pointing to Tickmarks A31. If I add one, then the reference and "Test" get moved up to A21.

I'm really not getting why you receive an error and I don't though...

gtrdude485
07-09-2008, 01:00 PM
I have no idea what is going wrong but I still cannot get the macro to work. It keeps giving me the saem error regarding merged cells not being the same size when trying to paste.