Help with if...then

[brownnr]

I have code that will find and list subfolders, I need help writing an if...then...else statement that basically says if the subfolder is already listed, don't add it to list, if not, then add at end of list. I've tried all I could, but I don't think I'm putting it in the right place in the code, or something. Here is my code:

'Lists Folders '
    Worksheets(1).Activate
    Dim row As Integer
    Dim SearchFolders As Variant
    row = 3
    LookInTheFolder = "I:\projects2\Koch\58MY8900\PROCESS\2013 Work (Phase 3)\DIH_Sulfolane\Equipment"
    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    For Each SearchFolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders
    Cells(row, 1) = Mid(SearchFolders, InStrRev(SearchFolders, "\") + 1)
    row = row + 1
    Next SearchFolders

Thanks!

 

[Solosideshow]

That's what I need help with, sorry I'm very new at VBA so I probably wasn't explaining as well as I should have. I posted the code in the original post, I don't know what commands are used to have it do what I need. I'll try to explain as best I can...

This finds and lists the subfolders with no problem:

'Lists Folders ' 
   Worksheets(1).Activate 
   Dim row As Integer 
   Dim SearchFolders As Variant 
   row = 3 
   LookInTheFolder = "I:\projects2\Koch\58MY8900\PROCESS\2013 Work (Phase 3)\DIH_Sulfolane\Equipment" 
   Set FileSystemObject = CreateObject("Scripting.FileSystemObject") 
   For Each SearchFolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders 
   Cells(row, 1) = Mid(SearchFolders, InStrRev(SearchFolders, "\") + 1) 
   row = row + 1 
   Next SearchFolders

I need help with the what and where. What do I tell it to get it to:
1. find if the subfolder name already exists in the list
2.if it does, do not input subfolder name
3. if it does not, move down to first blank and input subfolder name.

I kept running into errors when I tried all I could find, or knew(which is little). And it would be great if I could get it to also strikethrough the text if the subfolder name is in the list, but no longer found in the folder. Thanks!

lol.. ok
provide me:
1) the file folder or filename and location that you need to fine
2) The code you need to run if the file does not exist

 

[brownnr]

1) I:\projects2\Koch\58MY8900\PROCESS\2013 Work (Phase 3)\DIH_Sulfolane\Equipment is the folder I need it to look in and return all the subfolders that are in it. The subfolders will change, additional will be created, etc.
2) The code I do not know, I thought I could just modify the existing code I had since it does what I want it to do, I just want it now to recognize that it should only do that if the subfolder name is not already on the list.

 

[Solosideshow]

I am an idiot.. I see what you're asking lol...
Ok.. Change the Column and Sheet to your information

    Worksheets(1).Activate 
   Dim row As Integer 
   Dim SearchFolders As Variant 
   row = 3 
   LookInTheFolder = "I:\projects2\Koch\58MY8900\PROCESS\2013 Work (Phase 3)\DIH_Sulfolane\Equipment" 
   Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    For Each SearchFolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders 

Dim rFound As Range    
On Error Resume Next    
With Sheet1        
Set rFound = .Columns(1).Find(What:=Mid(SearchFolders, InStrRev(SearchFolders, "\") + 1) , After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)    
On Error GoTo 0        
If Not rFound Is Nothing Then            
 Cells(row, 1) = Mid(SearchFolders, InStrRev(SearchFolders, "\") + 1) 
                   row = row + 1        
end if    
End With   
Next SearchFolders

try that... do it step by step and let me know if that works out..

 

[brownnr]

Hmm, ok well it ran, didn't return an error, but didn't add a new subfolder I made for the test...

 

[jamcall]

Hmm, ok well it ran, didn't return an error, but didn't add a new subfolder I made for the test...

Check if it was added at the top of the list...? (row = 3)

Cheers,
~ Jim

 

[Solosideshow]

Check if it was added at the top of the list...? (row = 3)

Cheers,
~ Jim

Ahh Yes thats where it would have been..
if anything do

row = application.counta(range("A1:a300"))
row = row + 1

 

[jamcall]

.Find will hit on a partial match - so if there is a folder called "Test2" and you add a folder called "Test", it will find "Test2". Below is a method to search the existing cells to look for an exact match:

   If Not IsEmpty(Range("A3")) Then
       lastRow = Range("A3").End(xlDown).row
       row = lastRow + 1
   Else
        lastRow = 3
        row = 3
    End If
   Set colA = Range("A3:A" & lastRow)
   LookInTheFolder = "I:\projects2\Koch\58MY8900\PROCESS\2013 Work (Phase 3)\DIH_Sulfolane\Equipment"
   Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
   For Each SearchFolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders
        currFolder = Mid(SearchFolders, InStrRev(SearchFolders, "\") + 1)
        For Each currCell In colA
            folderExists = False
            If currCell = currFolder Then
                folderExists = True
                Exit For
            End If
        Next currCell
        If Not folderExists Then
          Cells(row, 1) = Mid(SearchFolders, InStrRev(SearchFolders, "\") + 1)
          Set colA = Range("A3:A" & row)
          row = row + 1
        End If
   Next SearchFolders

HTH,
~ Jim

 

[brownnr]

Same result with both of those solutions, no error, no "New Folder"

As a matter of fact, I cleared the list and ran it again, and it's not adding any folders...

 

[brownnr]

Nevermind, Jim your code worked, thank you both for your help!!

Solosideshow.....GO ARMY!

 

[Solosideshow]

Maybe cells value

    Worksheets(1).Activate 
   Dim row As Integer 
   Dim SearchFolders As Variant 
   row = 3 
   LookInTheFolder = "I:\projects2\Koch\58MY8900\PROCESS\2013 Work (Phase 3)\DIH_Sulfolane\Equipment" 
   Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    For Each SearchFolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders 

Dim rFound As Range    
On Error Resume Next    
With Sheet1        
Set rFound = .Columns(1).Find(What:=Mid(SearchFolders, InStrRev(SearchFolders, "\") + 1) , After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)    
On Error GoTo 0        
If Not rFound Is Nothing Then            
 Cells(row, 1).value = Mid(SearchFolders, InStrRev(SearchFolders, "\") + 1) 
                   row = row + 1        
end if    
End With   
Next SearchFolders

i am sorry i am at work and have to do all this by thinking.. can't really test it