Posts by yongle

did the code do what you want?

The code should now do exactly what you want

Variables used to reduce repitition in the code

Private 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

Quote from G Velkov

Thanks again, a summary of my observations:

This one works:

This one returns Compile Error: Expected name of statement.

Changed to:

Code

MkDir FolderPath & ActiveCell.Value & "\Jobsheets" & " - " & ActiveCell.Value

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.

Display More

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

Quote from G Velkov

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

replace:
MkDir FolderPath & ActiveCell.Value & "\Orders"
with:
MkDir FolderPath & ActiveCell.Value & "\Orders" & " - " & ActiveCell.Value

replace:
MkDir FolderPath & ActiveCell.Value & "\Jobsheets"
with:
MkDir FolderPath & ActiveCell.Value & "\Jobsheets" " - " & ActiveCell.Value

Quote from G Velkov

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

replace:
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=FolderPath & ActiveCell.Value

with:
ActiveSheet.Hyperlinks.Add Anchor:=Range("D" & ActiveCell.Row), Address:=FolderPath & ActiveCell, TextToDisplay:=FolderPath & ActiveCell

Quote from G Velkov

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

    If Dir("folder\subfolder\sourcefolder\*.*") = "" Then
        MsgBox "Source contains no visible files"
        Exit Sub
    End If
        
    MsgBox "carry on"
    code to create folders goes here

Quote from G Velkov

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"

Quote from G Velkov

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

Private 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

Private 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

Private 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)

Sub 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)

Private 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

On 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

Private 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

Debug.Print p, c.Address(0,0)

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