Posts by steve400243

That looks like the winner! I will continue to test for a bit more today, and on Monday. Have a nice weekend. Appreciate the quick work.

Almost there. It is including a total row under each Row that is not needed.

Here is the report how it should look. I ran it with some other test files. and manually deleted the unnecessary rows.

Many Thanks, Looks to be returning more rows than needed? Please have a look

THANK YOU - Paypal sent - OHV86366T52962708

I do a new report daily. So clearing the existing data in the main report file will work.

Excellent, Thank you Sir!

My Apologies, here is the code I have been using

Sub ConsolidateData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim wb As Workbook, sh As Worksheet, ary As Variant, fPath As String, fName As String, i As Long, rw As Long
Dim LastSourceRow As Long, SourceCount As Long
Const FirstSourceRow = 13
fPath = ThisWorkbook.Path & Application.PathSeparator
Set sh = ThisWorkbook.Worksheets("Sheet1")
sh.UsedRange.Offset(2).Clear
ary = Array("C3", "C4", "C5", "H2", "H3", "H4")
fName = Dir(fPath & "*.xls*")
rw = sh.Cells(sh.Rows.Count, 8).End(xlUp).Row + 1
   Do While fName <> ""
      If fName <> ThisWorkbook.Name Then
         'If rw > 3 Then
          '  sh.Rows(2).Copy sh.Rows(rw)
           ' rw = rw + 1
         'End If
         Set wb = Workbooks.Open(fPath & fName)
         With wb.Sheets(1)
         
         If IsDate(.Range("H4")) Then
            For i = 2 To 7
               sh.Cells(rw, i) = .Range(ary(i - 2)).Value
            Next
            LastSourceRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            If LastSourceRow >= FirstSourceRow Then
               For cRow = FirstSourceRow To LastSourceRow
                  If Application.WorksheetFunction.CountBlank(.Range("G" & cRow & ":K" & cRow)) Then
                     sh.Range("H" & rw).Value = .Range("C" & cRow).Value
                     sh.Range("I" & rw).Value = .Range("D" & cRow).Value
                     sh.Range("J" & rw).Value = .Range("B" & cRow).Value
                     sh.Range("K" & rw).Value = .Range("A" & cRow).Value
                     sh.Range("L" & rw).Resize(1, 10).Value = .Range("G" & cRow).Resize(1, 10).Value
                     rw = rw + 1
                  End If
               Next
            End If
         End If
         End With
         wb.Close False
         Set wb = Nothing
        sh.Range("B" & rw - 1).Resize(1, 20).Borders(xlEdgeBottom).Weight = xlThin
      End If
      
      fName = Dir
    
   Loop
sh.Range("B" & 3).Resize(rw - 3, 5).Font.ColorIndex = 1
sh.Range("B" & 3).Resize(rw - 3, 5).Font.Bold = False
sh.Range("L" & 3).Resize(rw - 3, 4).Replace What:="", Replacement:="NOT RECEIVED", LookAt:=xlWhole
sh.Columns.AutoFit
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

End Sub

10% paid via paypal to Ozgrid: 4T248943VP1080146

I am having an issue with this report and would like some changes made. I would like the report to look like the attached example, CFS on Hand Report, after ran, with no borders lines between MAWBS, and no open Spaces. For your review here is the notes I have made. I have several files in a folder on my desktop like the 2 examples Ever Eagle, and OOCL. all files will have a different number of rows from 13 up to row 39. The other workbook “CFS On Hand” Is a report file. I want to place this file in the folder with the files and when a user selects it a message box come up asking if they want to create a new report. Selecting “YES” will activate the macro to open each file in the folder and look for a date in cell “H4” in each file. If no date in that cell, skip that file. If a date is in that cell, look for any cells that are blank in any row that has Data in G13 thru J39. And copy that Row, up to Column “P”, over to the Report File. Each file can have a different number of Rows with Data up to Row 39. In the 2 Example File it would skip the OOCL file as no Date in in Cell H4. But it would copy over row 15 in the Ever Eagle file as it has open cells in the rows with data, and has a Devan date in cell H4. Needed Results As shown in the example. After opening each file and running the macro it would save the report in the file as CFS ON HAND REPORT – and the current date. Please let me know if I need to make another post? Please see the notes below and let me know. Thank you.

Got it to run now, I had to remove a temp file path in the code. Was this correct? I think I am having an issue updating links in the files? Keeps stopping and asking about updating the links.

Great Thank you - will test it out in a little while and revert with any questions or comments. I appreciate the quick work.

Pay Pal sent, please see above message for Ozgrid payment transaction ID.

Good Question, Data will always start in row 13 - No blank lines will ever be between data.

forgot to mention that 10% has been paid to Ozgrid Payapal -

Transaction ID # 85B43637DL6810443

Here is an example file, this one has 25 House Bills.

Many Thanks GCE.

I use the following VBA to open each file in a specified location and copy certain data from each file to a report.

Sub t()
Dim wb As Workbook, sh As Worksheet, ary As Variant, fPath As String, fName As String, i As Long, rw As Long
fPath = "X:\SEA Shares\warehouse\CFS and FMM Program\SEA Devanned January-2020\"
Set sh = Workbooks("New").Sheets(1)
ary = Array("C3", "C4", "C5", "H2", "H3", "H4")
fName = Dir(fPath & "*.xls*")    Do While fName <> ""        If fName <> ThisWorkbook.Name Then            Set wb = Workbooks.Open(fPath & fName)                For i = 2 To 7                    rw = sh.Cells(Rows.Count, 2).End(xlUp)(2).Row                    sh.Cells(rw, i) = wb.Sheets(1).Range(ary(i - 2)).Value                Next                wb.Close False        End If        fName = Dir    Loop
End Sub

I need it to also copy from each file, when opened, additional data and save as shown, in the example attached. all files opened will be the same format. They will all have a different number of House Bills, But row 35 would be the last row used in each file. I only want it to copy the rows with data.

The data from each file's cells noted in red. Please let me know if that makes sense. Thanks for your help.

Please let me know questions or comments.

Thanks for your time Rikcando, I appreciate it. It works as needed.

Hello, I have a worksheet with multiple lines of data, up to 500 +. There is a master number, column C, and there can be multiple house bill numbers in each Master Number. Column D. I need a way to have all the like Master numbers and corresponding house bill numbers, and the corresponding rows and Columns – A thru Y - be shaded a different alternating color. Please see the example, and I’m sorry if I’m not explaining this well enough. Thanks for all help. I could not figure out how to do this. grouping test.xlsx