PDA

View Full Version : Help Required in Create and Open Folder and Track Changes



anish.ms
11-11-2020, 09:24 AM
Hope you all are good and safe
Could somebody please help in modifying the codes as required below-

In the attached workbook there are two set of codes-

Sheet ("Follow-up Tracker")
Code checks the duplicates in column A and add a value in column V 'Follow-up Audit Files' against the row
And on selection change with Column V, it notifies the missing columns and creates / Open folder in the workbook path
/ Follow-up Audit Files/ Value in Column B / Value in Column A

I need help in changing the trigger from selection change to enter or double click in column V as now moving around the worksheet notifies and creates / open the folders

Sheet ("Track Changes")
I need to track only the changes in sheet "Follow-up Tracker' and not the changes in all the sheets and that too as per the example format given in sheet Track Changes 2
Cell Changed shall be Unique Code for the row and Column Heading for the column changed

Thanks in advance for your help!

Paul_Hossler
11-12-2020, 09:21 PM
I only looked at the double click in Col V part of the question

There's some test code left in, marked <<<<<<<<<

Since these are WS events 'Follow up Tracker' is the ActiveSheet. Really don't the 'Me.' but I like to use it

One unsolicited suggestion, I understand ay and ax are the X-Y coordinate system, but I'd use more 'Excel-like' variable names, like rowTarget and colTarget
Just a comment








Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ay = Target.Row
ax = Target.Column

MsgBox ay & " -- " & ax ' <<<<<<<<<<<<<<<<<<<<<<<<


If ax <> 22 Then Exit Sub
If ay = 1 Then Exit Sub
If Target.Value = Empty Then Exit Sub

MsgBox "Processing" ' <<<<<<<<<<<<<<<<<<<<<<<<
Exit Sub ' <<<<<<<<<<<<<<<<<<<<<<<<


mis_data = Empty
For x = 1 To 22
If Len(Me.Cells(ay, x)) = 0 Then
If mis_data <> Empty Then mis_data = mis_data & vbCr
mis_data = mis_data & Me.Cells(1, x)
End If
Next x

If mis_data <> Empty Then
MsgBox mis_data, vbInformation, "Missing Fields:"
'Exit Sub
End If

If Me.Cells(ay, "A") = Empty Then Exit Sub

chk_a = Me.Cells(ay, "A")
chk_b = Me.Cells(ay, "B")
aps = Application.PathSeparator
RootDir = ThisWorkbook.Path & aps & "Follow-up Audit Files"
isRootDir = GetAttr(RootDir)
If isRootDir <> 16 Then MkDir (RootDir)
VDir = ThisWorkbook.Path & aps & "Follow-up Audit Files" & aps & chk_b
isVDir = GetAttr(VDir)
If isVDir <> 16 Then MkDir (VDir)
UCN = ThisWorkbook.Path & aps & "Follow-up Audit Files" & aps & chk_b & aps & chk_a
isUCN = GetAttr(UCN)
If isUCN <> 16 Then MkDir (UCN)


#If Mac Then
RootFolder = MacScript("return (path to desktop folder) as String")
scriptstr = "return posix path of (choose folder with prompt ""Select the folder""" & " default location alias """ & RootFolder & """) as string"
folderPath = MacScript(scriptstr)
#Else
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = UCN
.Show
End With
#End If


End Sub


'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'End Sub

anish.ms
11-13-2020, 11:15 AM
Thanks a Ton for your continued support