0

I have information that is printed from files in a folder into columns 1,2,3, and 4 of an excel sheet. Columns 1 and 2 will only ever contain one cell of information but 2 and 3 will vary in length but will be equal to each other.

My goal is to do something like if for column A, if the cell next to it in column B is occupied, go to the row below and loop, else if the cell is empty then print the info for column 1 in that row.

Here is the full code!

Option Explicit

Sub LoopThroughDirectory()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim MyFolder As String
    Dim StartSht As Worksheet, ws As Worksheet
    Dim WB As Workbook
    Dim i As Integer
    Dim LastRow As Integer, erow As Integer
    Dim Height As Integer
    Dim RowLast As Long

    'turn screen updating off - makes program faster
    'Application.ScreenUpdating = False

    'location of the folder in which the desired TDS files are
    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"

    'Set StartSht = ActiveSheet
    Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1")

    'create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'get the folder object
    Set objFolder = objFSO.GetFolder(MyFolder)
    i = 1

    'loop through directory file and print names
'(1)
    For Each objFile In objFolder.Files
        If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then
'(2)
            'print file name to Column 1
            Workbooks.Open fileName:=MyFolder & objFile.Name
            Set WB = ActiveWorkbook
'(3)
            'copy HOLDER column from F11 (11, 6) until empty
            LastRow = Cells(Rows.count, 1).End(xlUp).Row
            Range(Cells(11, 6), Cells(LastRow, 6)).Copy
            StartSht.Activate
            'print HOLDER column to column 2 in masterfile in next available row
            Range("B" & Rows.count).End(xlUp).Offset(1).PasteSpecial
            WB.Activate
'(4)
            'copy CUTTING TOOL column from F11 (11, 7) until empty
            LastRow = Cells(Rows.count, 1).End(xlUp).Row
            Range(Cells(11, 7), Cells(LastRow, 7)).Copy
            StartSht.Activate
            'print CUTTING TOOL column to column 3 in masterfile in next available row
            Range("C" & Rows.count).End(xlUp).Offset(1).PasteSpecial
            WB.Activate

'(5)
            'print TDS information
            With WB
                For Each ws In .Worksheets
                        'print the file name to Column 1
                        StartSht.Cells(i + 1, 1) = objFile.Name
                        'print TDS name to Column 4
                        With ws
                            .Range("J1").Copy StartSht.Cells(i + 1, 4)
                        End With
                        i = i + 1

                'move to next file
                Next ws
'(6)
                'close, do not save any changes to the opened files
                .Close SaveChanges:=False
            End With
        End If
    'move to next file
    Next objFile
    'turn screen updating back on
    'Application.ScreenUpdating = True
    ActiveWindow.ScrollRow = 1
'(7)
End Sub

My ultimate goal is for my excel sheet to look like this: (before and after)

Before Image

After Image

Taylor
  • 181
  • 1
  • 3
  • 24
  • 1
    It doesn't really look like you've tried anything to solve the problem. So far you've described the logic somewhat. Can you try to *implement* it in the code? – David Zemens Jun 04 '15 at 16:34
  • I've actually tried quite a lot but none of it is even close to succesful and starts to mess up my other code which is why I didn't put anything in. I have been trying to formulate how to fix this problem and I just now thought that the easiest solution would be to print the "name" from column 1 and 4 all the way down to the last cell filled in columns 2 and 3, then insert a blank row, and continue to loop like that... I have no clue how to go about that though. I am new to VBA @DavidZemens – Taylor Jun 04 '15 at 16:42
  • based on the code you have included in the Q, it's not really clear how your "after" is derived from the "before". The code you provide is a loop over all worksheets -- so you're processing the `ws` iteration and doing something to the `StartSht` object -- I think it's really difficult to help solve this problem without access to the workbook, or without a better-formulated question. Sorry! – David Zemens Jun 04 '15 at 16:47
  • 1
    You should probably put your full code in the question. It's not overwhelming :) – David Zemens Jun 04 '15 at 16:50
  • If you would like access to the workbook, I have tester input files and the code if you would want me to send them to you as help @DavidZemens – Taylor Jun 04 '15 at 16:52
  • i see what's going on... you're not really working well with the `LastRow` variable. – David Zemens Jun 04 '15 at 17:02
  • Does that mean I'm not utilizing it enough or too much? Or that I'm using it wrong? – Taylor Jun 04 '15 at 17:08
  • Well... it means you're not using it the way I would use it LOL. Give me a few minutes I will try to tinker with your code. – David Zemens Jun 04 '15 at 17:09
  • Hahah ah gotcha. Yah I've pretty much just been tinkering with the most elementary code (and probably using it wrong since I'm new to VBA) but somehow I've had it work for me so far. Awesome. thank you! – Taylor Jun 04 '15 at 17:14

1 Answers1

0

Let's see if this gets you closer:

'(2)
            'print file name to Column 1
            Set WB = Workbooks.Open fileName:=MyFolder & objFile.Name
            Set ws = WB.ActiveSheet
'(3)
            'copy HOLDER column from F11 (11, 6) until empty
            With ws
                lastRow = GetLastRowInColumn(ws, "A")
                .Range(.Cells(11,6), .Cells(lastRow, 6)).Copy
            End With

    Dim destination
    lastRow = GetLastRowInColumn(startSht, "B")
    Set destination = StartSht.Range("B" &   lastRow).Offset(1)
            'print HOLDER column to column 2 in masterfile in next available row
            destination.PasteSpecial
'(4)

            'ReDefine the destination range to paste into Column C
            lastRow = GetLastRowInColumn(startSht, "C")
            Set destination = StartSht.Range("C" & lastRow).Offset(1)

            With ws
                'copy CUTTING TOOL column from F11 (11, 7) until empty
                LastRow = GetLastRowInColumn(ws, "G")
                'print CUTTING TOOL column to column 3 in masterfile in next available row
                .Range(.Cells(11, 7), .Cells(LastRow, 7)).Copy _
                    Destination:=destination
            End With
'(5)
            With WB
               'print TDS information
                For Each ws In .Worksheets
                        'Determine what is the last row in this sheet, +1 to get the next empty row
                        i = GetLastRowInSheet(ws) +1

                        'print the file name to Column 1
                        StartSht.Cells(i, 1) = objFile.Name
                        'print TDS name to Column 4
                        With ws
                            .Range("J1").Copy StartSht.Cells(i, 4)
                        End With

                'move to next file
                Next ws
'(6)
                'close, do not save any changes to the opened files
                .Close SaveChanges:=False
            End With

The important part is that we're not simply incrementing i by one, we're using the GetLastRowInSheet function (below) to reset i to the last row in the worksheet + 1.

i = GetLastRowInSheet(ws) + 1

You'll need to include these two functions, the purpose of which is to simplify the clunky (and repetitive) way you're determining the LastRow. (borrowed from this awesome answer)

Function GetLastRowInColumn(theWorksheet as Worksheet, col as String)
    With theWorksheet
        GetLastRowInColumn = .Range(col & .Rows.Count).End(xlUp).Row
    End With
End Function

Function GetLastRowInSheet(theWorksheet as Worksheet)
Dim ret
    With theWorksheet
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            ret = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            ret = 1
        End If
    End With
    GetLastRowInSheet = ret
End Function
Community
  • 1
  • 1
David Zemens
  • 53,033
  • 11
  • 81
  • 130
  • Hm, the i = at the beginning of the For loop caused the first file name location to be empty and move to the position of the second one (in the correct spot though so yay!) and the second to move to the position of the third...and so on – Taylor Jun 04 '15 at 19:01
  • Well I get that it's now grabbing the last row in the sheet and printing the name... I'm trying to move it so it prints the name first but I seem to be messing up my code even more...would that be the wrong way to try to solve it? – Taylor Jun 04 '15 at 19:09
  • I don't even know what you're asking at this point. Why does it matter whether it prints the name "first" as long as it prints the name in the correct row? – David Zemens Jun 04 '15 at 19:10
  • Let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/79690/discussion-between-taylor-and-david-zemens). – Taylor Jun 04 '15 at 19:12
  • 1
    Sorry man but I don't have time to teach you VBA. I've done 95% of the solution for you -- the other 5% is simply because I'm not sure what is happening (i'm writing code without the file, so I can't see what's happening) and you're hung up on some details. You will figure it out with some trial and error. – David Zemens Jun 04 '15 at 19:14
  • You have helped to guide me toward a fix given my original code and I greatly appreciated that. If this is such a small detail, then I do not really understand with not helping find a solution at this point or at least helping to guide me in the right direction, as you have been. I also did offer to send you the files if that would have been helpful. **Printing in the wrong row** was my problem to start with in the beginning of this question so to me that is not a small problem. – Taylor Jun 04 '15 at 19:29
  • I don't have to explain myself to you. This isn't about gratitude, it's about the fact that at some point, I don't have any more time to give you. Sorry man, it is nothing personal. I am reasonable sure that if you step through the code using the debugging techniques I linked to above, you will be able to figure it out. It might take you an hour or two, or it might take you 15 minutes, but you'll get it. – David Zemens Jun 04 '15 at 19:39