Macro is skipping the first available empty cell and instead pasting data several rows below

[Gintoki01]

Hi everyone!


Honestly this has stumped me for a while now. So my macro deals with sending some data from one excel file to another. I am having this weird glitch where sometimes the data will not be pasted to the next available empty row but instead it gets pasted about 150 rows lower than intended. What makes its even weirder is that the cells in-between where the data should be pasted and where it actually goes has no data or value in it. all the cells are empty.


So why is the macro pasting in the wrong place? I have made sure the cells are clear and tried a few different ways to make sure they are really empty but it still happens. My current hypothesis is that the macro is fine but there is something wrong with the excel file, although I do not know what it could be.

I will also post the code for the macro in case the problem has to do with that.


Any help with this would be great!

[FONT=Verdana]
Option Explicit[/FONT][/FONT]
Public Sub transformData()
      Dim i, nLastRowMe, nLastRowOut, nRecords As Long
      Dim strSheet, str As String
      Dim wbMe, wbOut As Workbook
      
     Application.ScreenUpdating = False
 
      Set wbMe = ActiveWorkbook
      
      i = 36
      Do While (i > 16)
            If Trim(Range("B" & i)) <> "" Then
                  nLastRowMe = i
                  i = 16
            End If
            i = i - 1
      Loop
      
      If nLastRowMe <= 16 Then
            MsgBox "There is no data to transfer."
            Exit Sub
      End If
      nRecords = nLastRowMe - 17
      
      Set wbOut = Workbooks.Open("Desktop/Excel Macro/2018Monthly.xls")
      
      strSheet = CStr(Month(wbMe.Sheets("Macro Data").Range("P2")))
      With wbOut.Sheets(strSheet)
            .Activate
            i = 220
            nLastRowOut = i
            Do While (i > 41)
                  str = .Range("A" & i).Value & .Range("B" & i).Value & .Range("C" & i).Value & .Range("D" & i).Value & .Range("E" & i).Value & .Range("F" & i).Value & .Range("G" & i).Value & .Range("H" & i).Value & .Range("I" & i).Value & .Range("J" & i).Value & .Range("K" & i).Value & .Range("L" & i).Value & .Range("M" & i).Value
                  If Replace(str, 0, "") <> "" Then
                        nLastRowOut = i + 1
                        GoTo copySections
                  End If
                  i = i - 1
            Loop


copySections:
'This section deals with the actual process of copying the data and pasting it to the other excel file.


            If i = 41 Then nLastRowOut = 42
            
                   
            'wbMe.Sheets("Macro Data").Range("F3:F21" & nLastRowMe).Copy
                  '.Range("F" & nLastRowOut).PasteSpecial xlPasteValues
            wbMe.Sheets("Macro Data").Range("F3:F21" & nLastRowMe).Copy
                 .Range("J" & nLastRowOut).PasteSpecial xlPasteValues
            wbMe.Sheets("Macro Data").Range("G3:G21" & nLastRowMe).Copy
                  .Range("M" & nLastRowOut).PasteSpecial xlPasteValues
            'wbMe.Sheets("Macro Data").Range("E3:E21" & nLastRowMe).Copy
                  '.Range("D" & nLastRowOut).PasteSpecial xlPasteValues
            
            nRecords = nRecords + nLastRowOut
            wbMe.Sheets("Macro Data").Range("A4").Copy
                  .Range("A" & nLastRowOut).PasteSpecial xlPasteValues
                  '.Range("A" & nLastRowOut).Font.Size = 8
            wbMe.Sheets("Macro Data").Range("A5").Copy
                  .Range("B" & nLastRowOut).PasteSpecial xlPasteValues
            wbMe.Sheets("Macro Data").Range("A6").Copy
                  .Range("C" & nLastRowOut).PasteSpecial xlPasteValues
            wbMe.Sheets("Macro Data").Range("A8").Copy
                  .Range("E" & nLastRowOut).PasteSpecial xlPasteValues
            wbMe.Sheets("Macro Data").Range("A9").Copy
                  .Range("F" & nLastRowOut).PasteSpecial xlPasteValues
            wbMe.Sheets("Macro Data").Range("A7").Copy
                  .Range("D" & nLastRowOut).PasteSpecial xlPasteValues
      End With
      
exitHere:
      With wbOut
            '.Save
            '.Close
      End With
      
 MsgBox "Data has been transferred."
 'Alerts user that the data has been transferred correctly.
      
 Application.CutCopyMode = False
 Application.ScreenUpdating = True
 
End Sub

 

[jmacleary]

Hi there. Is it possible that the If statement in the do loop is never executed - if so then nLastRowOut would stay at 220?

 

[Gintoki01]

Hi jmacleary! Sorry for the late reply.

Your suggestion sounded plausible so I decided to try something and I found the reason why I am getting this error, although I do not know how to go about fixing it.

So you were correct in that this loop does not initiate:

Do While (i > 41)                 
str = .Range("A" & i).Value & .Range("B" & i).Value & .Range("C" & i).Value & .Range("D" & i).Value & .Range("E" & i).Value & .Range("F" & i).Value          & .Range("G" & i).Value & .Range("H" & i).Value & .Range("I" & i).Value & .Range("J" & i).Value & .Range("K" & i).Value & .Range("L" & i).Value & .Range("M" & i).Value
                  If Replace(str, 0, "") <> "" Then
                        nLastRowOut = i + 1
                        GoTo copySections
                  End If
                  i = i - 1
            Loop

I stepped through the macro two times. Both times I transferred data to two different sheets that had data in them already. The first time I stepped through it, I transferred the data to Sheet 1 and the loop executed and pasted the code in the proper row.

The second time I stepped through it, I transferred the data to sheet 2 but this time the loop did not execute.

So now I am even more confused about why it worked for one sheet and not for another.

 

[Gintoki01]

UPDATE:

I am pretty sure I figured out how to fix my issue. I had to change the value of i to 219 because of formula in a cell in row 220. The macro was working sometimes because the formula was not present in some of the sheets I was using. I will update this again if the issue occurs again but for now it is solved.