ajliaks


Hi guys,
I have an excel datasheet where each row has on it a Shape called "myShape" + the Number of the Row where it is located, in example:



Re: Vba Excel 03 - Code to detect before Sorting / deleting Rows

Peter Mo.


Hi Aldo

You could have your own collection of shapes adding them in the order of the Top property. Something like ...

Code Snippet

Set colShapes = New Collection
For Each myShape In Sheets(1).Shapes
For inc = 1 To colShapes.Count
If myShape.Top < colShapes(inc).Top Then
colShapes.Add Item:=myShape, before:=inc
Exit For
End If
Next inc
If inc > colShapes.Count Then colShapes.Add myShape
Next myShape

For Each myShape In colShapes
MsgBox myShape.Name
Next myShape

Regards

Peter Mo.






Re: Vba Excel 03 - Code to detect before Sorting / deleting Rows

ajliaks

Hi Peter, thanks for answering, but I do not understand how to implement your idea. Could you be a little more specific





Re: Vba Excel 03 - Code to detect before Sorting / deleting Rows

Peter Mo.

Hi

Maybe this will help

Code Snippet

Sub test()

Dim colShapes As Collection
Dim myShape As Shape
Dim inc As Long
Dim myCaller As String

' who called us

myCaller = Application.Caller

' create a new collection

Set colShapes = New Collection

' work through the shapes in the worksheet

For Each myShape In Sheets(1).Shapes


For inc = 1 To colShapes.Count

' look for one with a higher .Top

If myShape.Top < colShapes(inc).Top Then
colShapes.Add Item:=myShape, before:=inc
Exit For
End If
Next inc

' If I didn't find one then add this one to the end of the collection

If inc > colShapes.Count Then colShapes.Add myShape
Next myShape

' we now have collection with the shapes in their row order

' now find the position of the one that called us

For inc = 1 To colShapes.Count
If colShapes(inc).Name = myCaller Then Exit For
Next inc

' In this case tell the world the row number

MsgBox "Row " & inc

End Sub

Regards

Peter Mo.





Re: Vba Excel 03 - Code to detect before Sorting / deleting Rows

ajliaks

Get it!

Thanks a lot!

Aldo.






Re: Vba Excel 03 - Code to detect before Sorting / deleting Rows

Peter Mo.

Hi Aldo

I've been thinking about it again. What I've given you is more of a general solution. However, there is a simpler way if there are a few restriction e.g. the same row heights across all the relevant rows. Try this ...

Code Snippet

Sub Test2()

Dim strCaller As String
Dim lngTop As Long
Dim lngRow As Long

' who called us

strCaller = Application.Caller

' what is the top of the shape

lngTop = ActiveSheet.Shapes(strCaller).Top

' divide the top of the shape by the row height to get the row number

lngRow = (lngTop \ Rows(1).Height) + 1

' now we have the row

MsgBox lngRow

End Sub

Regards

Peter Mo.





Re: Vba Excel 03 - Code to detect before Sorting / deleting Rows

ajliaks

Hi Peter,

That's exacly what I did (your previous answer gave me the idea) and works nice.

Function CalculateRowNr(Optional FirstRow As Variant, Optional InitialHeight As Variant , Optional ShapeHeight As Variant)
CalculateRowNr = ((ActiveSheet.Shapes(Application.Caller).Top - InitialHeight) / ShapeHeight) + FirstRow
CalculateRowNr = Round(CalculateRowNr, 0)
End Function

The complication is that I have users using Office 03, and Office 07 so I will have to read application.version and change the parameters, but that's very simple to do.

The challenge I have just now, is when users filter data and then click the button.

If the user filters data by row 4, and gets rows("1:3") hidden, what I see at the monitor is row 4 "instead" of row 1, but when clicking the attached Shape and reading Shape.Top I get the position related to row 1 instead of the position related to row 4 (the one I think I am clicking)...

Do you have any good ideas

In addittion, when I run the macro, the date of my system changes, and I can not find the problem.

I am using the code below in order to retrieve file dates (Created, modify, accessed):

Function GettingDateCreated(Optional FilePathAndName As Variant) As Variant
Dim objFSO, objFile
Dim FileExists As Boolean
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
FileExists = objFSO.FileExists(FilePathAndName)

Select Case FileExists
Case True: Set objFile = objFSO.getFile(FilePathAndName): GettingDateCreated = objFile.DateCreated
Case False: GoTo ErrHandler
End Select
Set objFSO = Nothing: Set objFile = Nothing
Exit Function

ErrHandler:
MsgBox "Error!: Module GettingDateCreated" & vbNewLine & "The file you are looking for does not exists", vbExclamation
End Function

Thanks again, I really appreciate your help.

Aldo.