Posts by yongle
-
-
The code should now do exactly what you want
Variables used to reduce repitition in the code
Code
Display MorePrivate Sub CommandButton2_Click() Dim FolderPath As String, Cel As Range, Cust As String, CustPath As String Set Cel = ActiveCell Cust = Cel.Value If Not Application.Intersect(Cel, Range("A:A")) Is Nothing Then If Cel.Hyperlinks.Count = 0 Then 'Main folder path FolderPath = "C:\Users\" & Environ("Username") & "\Desktop\Customers\" 'Makes the directory assuming the Customers folder is already existing CustPath = FolderPath & Cust MkDir CustPath 'Makes the sub directory Orders MkDir CustPath & "\Orders" & " _ " & Cust 'Makes the sub directory Job Sheets MkDir CustPath & "\Jobsheets" & " - " & Cust 'Move files to customer folder Call MoveFiles("C:\Users\" & Environ("Username") & "\Desktop\scans\", CustPath & "\Jobsheets" & " - " & Cust & "\") 'Creates hyperlink ActiveSheet.Hyperlinks.Add Anchor:=Range("D" & Cel.Row), Address:=CustPath, TextToDisplay:=CustPath End If End If End Sub 'checks for empty scans folder Private Sub MoveFiles(oldPath As String, newPath As String) Dim StrFile As String, msg As String StrFile = Dir(oldPath & "*.*") If StrFile = "" Then msg = "You didn't scan any new files, did you?" Else msg = "Scans copied OK, please scan new Job Sheets for the next customer." Do While Len(StrFile) > 0 Name oldPath & StrFile As newPath & StrFile StrFile = Dir Loop End If MsgBox msg, , "" End Sub
-
Thanks again, a summary of my observations:
This one works:
This one returns Compile Error: Expected name of statement.
Changed to:
So it creates the subfolders "Scans - nameofcustomer" but it doesn't move the actual scanned files from the source.
The error is "File not found" and it highlights Name oldPath & StrFile As newPath & StrFile
I imagine that the string insertion breaks the path.
The new path name is now inconsistent because of adding the customer name to the folder names
Name oldPath & StrFile As newPath & StrFile
If need help in correcting the string, please post the whole of your amended code
-
The last thing was my original request form the other Thread, is it possible to add the name of the customer to the names of the folders "Orders" and "Jobsheets"
Test this
-
Could be beneficial if instead of the hyperlink being created on the text in the selected cell, to be in another cell, let's say in D column on the same row.
Also to see the resulting path visible as text: "C:\Users\"Username\Desktop\Customers\John Smith" still hyperlinked but just to the customer's name level, not the subfolders
Test this
-
The behaviour that I have mentioned is observed only if we don't follow the routine of Operator to scan files, then select cell, click button -> Excel creates folders, subfolders, creates hyperlink, moves files, etc.
I noticed it when I forgot to put files into the source.
You could prevent the folders being created if the source folder is empty when the macro is run
Put something like this early in the Command Button procedure
-
The last thing was my original request form the other Thread, is it possible to add the name of the customer to the names of the folders "Orders" and "Customers".
Is it a typo ?
"Orders" and "Customers"
I would expect ..
Orders" and
"Customers""Jobsheets" -
I did notice that if we run the action and already have the folders generated but there was nothing in the source, and then we scan things and run it again, it breaks it. If the folders are deleted and the hyperlink removed though, then it works again. That is not concern because our routine needs to be the same and if we follow it, it works absolutely flawlessly.
Before moving on to your "added extras", let's resolve the above
1. Run MoveFiles when the sub-folder is created
- is this already working flawlessly?
2. Run MoveFiles again later
Additional macro required containing this line
Call MoveFiles("Here Enter the source folder path ending path with \","Here Enter the destination folder path ending path with \")
The source path is constant
The destination path is fixed EXCEPT for customer name ( DestinationFolderPath & "Customer Name" & "\Jobsheets" )
- would a line in the macro asking the user to click on the cell containing CUSTOMER name work?
- is there only one sheet in the workbook? (if not which sheet contains customer names matching folder names ?)
Let me know your thoughts
-
The codes are almost identical and both clear the cell (with Target.ClearContents)
The cell is not being cleared in YOUR workbook which suggests that something else is going on, that we are unaware of.
1. Are the macros installed EXACTLY as posted ?
2. Are any other event macros acting on your workbook ?
If nothing is obvious to you, create a new workbook with only ONE sheet
- test each one of the event macros in turn
- do nothing other than amending values in J8:J400
- I expect both macros to clear the cell
- After that, look at your workbook and work out what is different
-
Try this on some test data
Code
Display MorePrivate Sub CommandButton1_Click() Dim FolderPath As String If Not Application.Intersect(ActiveCell, Range("A:A")) Is Nothing Then If ActiveCell.Hyperlinks.Count = 0 Then 'Main folder path FolderPath = "C:\Users\" & Environ("Username") & "\Desktop\Customers\" 'Make the directory assuming the Quotes folder is already existing MkDir FolderPath & ActiveCell.Value 'Make the sub directory Costings MkDir FolderPath & ActiveCell.Value & "\Orders" 'Make the sub directory Reference MkDir FolderPath & ActiveCell.Value & "\Jobsheets" Call MoveFiles("Here Enter the source folder path ending path with \", FolderPath & ActiveCell.Value & "\Jobsheets\") 'Create hyperlink ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=FolderPath & ActiveCell.Value End If End If End Sub 'place in same code module as above procedure Private Sub MoveFiles(oldPath As String, newPath As String) Dim StrFile As String StrFile = Dir(oldPath & "*.*") Do While Len(StrFile) > 0 Name oldPath & StrFile As newPath & StrFile StrFile = Dir Loop End Sub
-
or this
Code
Display MorePrivate Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("J8:J400")) Is Nothing Then On Error GoTo TheEnd Application.EnableEvents = False Target.Offset(, -1) = Target.Offset(, -1) + Target Target.ClearContents End If TheEnd: On Error GoTo 0 Application.EnableEvents = True End Sub
-
must be done by vba
right-click on sheet tab \ View Code \ paste code into the code window
Code
Display MorePrivate Sub Worksheet_Change(ByVal Target As Range) If [A1] = "" Then Exit Sub 'when i have a value in cell a1 On Error GoTo TheEnd Dim sumVals As Double: sumVals = [A1] + [A2] If Target.Address = "$A$2" Then 'if i type a value into cell a2 Application.EnableEvents = False [A1] = sumVals 'automatically add that value to cell a1 [A2].ClearContents 'clear the cell a2 Application.EnableEvents = True End If TheEnd: On Error GoTo 0 End Sub
-
Please post the macro that you are currently using to create the folders
thanks
-
Adapt code below to suit your needs
More detailed information is required if you need further help
Place the code below in the Word document module
AND add reference to Microsoft Excel object library (see vba editor \ Tools \ References)
Code
Display MoreSub InsertTextFromExcelInWordCell() 'excel variables Dim xlWb As Excel.Workbook, xlTxt As String Set xlWb = Excel.Workbooks.Open("C:\TestArea\TextForWord.xlsx") xlTxt = xlWb.Sheets(1).Range("A5").Value 'word variables Dim wdDoc As Word.Document, wdTbl As Word.Table Set wdDoc = ActiveDocument Set wdTbl = wdDoc.Tables(1) 'place value in the cell With wdTbl.Cell(2, 5).Range 'this is row2 & column 5 .Delete .InsertAfter Text:=xlTxt End With xlWb.Close False End Sub
-
So - only ONE match , values updated in the SAME row, AND 3 (new) column values added when p increments by one
(Error handling added to prevent code failing if match for strFind is not found)
Code
Display MorePrivate Sub CommandButton1_Click() 'Finds criteria selected from Combobox in range(column 1) and populates last 3 empty columns in that row with data from textboxes created Dim c As Range, strFind As String, firstAddress As String Dim p, j As Long, lastcol As Long strFind = ComboBox1.Value With ThisWorkbook.Worksheets("Award_Criteria_Value").Range("A1:A100") On Error Resume Next Set c = .Find(what:=strFind, After:=.Cells(.Rows.Count, 1), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, searchDirection:=xlNext, MatchCase:=False) On Error GoTo 0 If Not c Is Nothing Then For p = 1 To number lastcol = c.Parent.Cells(c.Row, Columns.Count).End(xlToLeft).Column c.Offset(, lastcol).Value = Controls("TB1" & p).Text c.Offset(, lastcol + 1).Value = Controls("TB2" & p).Text c.Offset(, lastcol + 2).Value = Controls("TB3" & p).Text Next p End If End With 'Calls Clear_Form() sub Clear_Form End Sub
-
In UK
CodeOn Error Resume Next Result = WorksheetFunction.VLookup(Sheets("Sheet XX").Range("A6"), Sheets("Besoin de 3 semaines").Range("A:V"), 22, 0) If Err.number <> 0 Then 'all is good Else 'what happens if value in A6 is not found End If
Perhaps for you
Result = Worksheetfunction.Vlookup(Sheets("Sheet XX").Range("A6");Sheets("Besoin de 3 semaines").range("A:V");22;0)
NOTE
You must include error handling
If match is not found in Excel, the code shows #N/A
If match is not found in VBA, the code fails and stops
-
Code is easier to read if you click on </> and post your code inside the code window
My understanding
strFind is the same value for every required match
when p = 1
and strFind is found
... the values in TB11, TB21 and TB31 are written to 3 new columns in the found cell's row
p is now increased to 2
Am I correct in thinking that you want the code to find the 2nd occurrence of strFind in column A
and when strFind is found
... the values in TB12, TB22 and TB32 are written to 3 new columns in that row
etc
If not correct - please clarify what should happen when p = 2
If my understanding is correct, test this amended code on a copy of your workbook
Code
Display MorePrivate Sub CommandButton1_Click() 'Finds criteria selected from Combobox in range(column 1) and populates last 3 empty columns in that row with data from textboxes created Dim c As Range, strFind As String, firstAddress As String Dim p, j As Long, lastcol As Long strFind = ComboBox1.Value With ThisWorkbook.Worksheets("Award_Criteria_Value").Range("A1:A100") Set c = .Find(what:=strFind, After:=.Cells(.Rows.Count, 1), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, searchDirection:=xlNext, MatchCase:=False) lastcol = c.Cells(p, Columns.Count).End(xlToLeft).Column If Not c Is Nothing Then firstAddress = c.Address Do p = p + 1 c.Offset(0, lastcol).Value = Controls("TB1" & p).Text c.Offset(0, lastcol + 1).Value = Controls("TB2" & p).Text c.Offset(0, lastcol + 2).Value = Controls("TB3" & p).Text Set c = .FindNext(c) If p = number Then Exit Do Loop While c.Address <> firstAddress End If End With 'Calls Clear_Form() sub Clear_Form End Sub
-
Insert this line
above line beginning lastcol = ...
And look in the immediate window in VBA editor
(Display immediate window with {CTRL} g
Is VBA finding the same cell repeatedly ?
.Find returns the first value only
.FindNext is required to return all the other values
See this link which shows how to use .Find and .FindNext together https://docs.microsoft.com/en-…/api/excel.range.findnext
Happy to provide further help if you cannot resolve it.
-
Before getting started lets find out EXACTLY what you want to happen
Is it always... the SAME Excel charts
... from the SAME workbook
... placed in the SAME PowerPoint locations
... each time the procedure is run?
-
With Data Range A10:A100000
To count the number of non-empty rows in that range above value "p"
Named range RefersTo formula
=COUNTA(OFFSET(Sheet1!$A$10,0,0,MATCH("p",Sheet1!$A$10:$A$100000,0),1))-1