CODEWITHSUNDEEP
vbaexcel
analyticalpicasso
analyticalpicasso

Reputation: 1993

Excel Macro Button not displaying correct data

I have one button macro for reading data from excel files after leaving some(irrelevent starting rows of detail) rows(A1-A10) and merging all those files in single file.

It runs correctly when i use product files(excel files which have details about particular product). But when i use excel files which has company details it reads one row from irrelevant row(A5) then goes to the relevant data part to read.

I am not able to understand why it is reading one row i.e. company name from company excel files. i want it to directly go to (A11)th row to read. Which it does with produt files.

Product files are the files which have particular product details. Whereas Company Files are the files which has details of all products of particular company.

With my code below, i want to know that why it is reading company name(row A5), which it should not read.

 Sub Button2_Click()
  Dim basebook As Workbook
  Dim mybook As Workbook
  Dim sourceRange As Range
  Dim destrange As Range
  Dim SourceRcount As Long
  Dim N As Long
  Dim rnum As Long
  Dim MyPath As String
  Dim SaveDriveDir As String
  Dim FName As Variant

  SaveDriveDir = CurDir
  MyPath = "C:\"
 ChDrive MyPath
 ChDir MyPath

 FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
 MultiSelect:=True)
 If IsArray(FName) Then
 Application.ScreenUpdating = False
 Set basebook = ThisWorkbook

  For N = LBound(FName) To UBound(FName)
  Set mybook = Workbooks.Open(FName(N))

  rnum = LastRow(basebook.Worksheets(1)) + 1

  Set sourceRange = mybook.Worksheets(1).UsedRange
  SourceRcount = sourceRange.Rows.Count
  Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

   'basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
  ' This will add the workbook name in column D if you want

   sourceRange.Copy destrange
   ' Instead of this line you can use the code below to copy only the values

   ' With sourceRange
   ' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
   ' Resize(.Rows.Count, .Columns.Count)
   ' End With
   ' destrange.Value = sourceRange.Value

   mybook.Close False

  'Clear Rows
     rnum = LastRow(basebook.Worksheets(1)) + 1
       While Not rnum = 2
      If basebook.Worksheets(1).Cells(rnum, 1).Value = "" Or
        Left(basebook.Worksheets(1).Cells
              (rnum, 1).Value, 9) = "Copyright" Or Left                                                      
          (basebook.Worksheets(1).Cells(rnum, 1).Value, 4) = "Free" Or  Left
          (basebook.Worksheets(1).Cells(rnum, 1).Value, 7) = "Product" Or
        Left(basebook.Worksheets(1).Cells(rnum, 1).Value, 9) = "Intl Port" Or 
        Left(basebook.Worksheets(1).Cells(rnum, 1).Value, 5) = "House" Or 
       Left(basebook.Worksheets(1).Cells(rnum, 1).Value, 7) = "Arrival" Or
       Left(basebook.Worksheets(1).Cells(rnum, 1).Value, 5) = "Bill " Then
       basebook.Worksheets(1).Rows(rnum).Delete
         End If
       rnum = rnum - 1
           Wend

         Next
      End If
        ChDrive SaveDriveDir
      ChDir SaveDriveDir
     Application.ScreenUpdating = True
      End Sub

      Function LastRow(sh As Worksheet)
      On Error Resume Next
      LastRow = sh.Cells.Find(What:="*", _
     After:=sh.Range("A1"), _
        Lookat:=xlPart, _
       LookIn:=xlFormulas, _
      SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
       MatchCase:=False).Row
       On Error GoTo 0
  End Function

Upvotes: 0

Views: 326

Answers (1)

D_Bester
D_Bester

Reputation: 5931

Instead of this:

Set sourceRange = mybook.Worksheets(1).UsedRange
SourceRcount = sourceRange.Rows.Count

Try this:

With mybook.Worksheets(1)
    SourceRcount = .UsedRange.Rows.Count
    Set sourceRange = .UsedRange.Offset(10, 0).Resize(RowSize:=SourceRcount - 10)
End With

By directly copying only what you want you avoid the need to delete the rows later.

Upvotes: 1

Related Questions