Code Ignores Last Occupied Cell in Column B

[Turk182]

Hello, All.
Both the "fiber tab" and the "plastic tab" sections of code below are essentially IDENTICAL,
but – for some reason – the code in the fiber tab seems to "ignore" the last occupied cell in that column, passing on up to the column heading to begin the "paste" from there (instead of one row below the last occupied cell).

This error does not happen in the plastic tab section..., and I do not see the difference. Please help.
The code for both sections is the same, and the spreadsheet information is only text....

"

 

[Alex Blakenburg]

I don't think you have included all the code and some of the code you have included looks quite odd.
Perhaps tell us what you are trying to do ?

Some of the odd looking code is:
Offset(0 1) > would expect a comma between the 0 and 1
Range(Selection Selection.End(XlUp)).Select > ??? not to mention that it is followed by an XlDown.

 

[Turk182]

I don't think you have included all the code and some of the code you have included looks quite odd.
Perhaps tell us what you are trying to do ?

Some of the odd looking code is:
Offset(0 1) > would expect a comma between the 0 and 1
Range(Selection Selection.End(XlUp)).Select > ??? not to mention that it is followed by an XlDown.

Hi Alex, thanks for the reply.… Not sure why the comma didn't show up when I pasted it; it's still in the code in VBA though.

I have two workbooks: A SOURCE workbook that has a “Cover Page” tab where a vendor’s name (in Cell C6) is copied then pasted in a DESTINATION workbook, Cell B6, beside (to the left of) every row of data that that currently exists without a vendor name (and only in those rows).

Below is that section of code and it's entirety:

Sub SUPPLIER_NAME_Fill_down_based_on_the_adjacent_row()

Dim LastRow As Long
LastRow = Range("B" & Rows.Count).End(xlUp).Row

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & Select it", ButtonText:="Choose SAME SUPPLIER Dec' Sheet AGAIN")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets("Cover Page").Range("C6").Copy


'FIBER
ThisWorkbook.Activate

Worksheets("Fiber data").Select
'(From Below, Go To) Last SUPPLIER-occupied Cell
Range("B2000").End(xlUp).Select
'Last occupied Cell + 1 Row Dn


ActiveCell.Offset(1, 0).Select

'Paste Supplier Name Once
ActiveCell.PasteSpecial xlPasteValues
'(From Below, Go To) Last APN-occupied Cell
Range("C2000").End(xlUp).Select
'Last occupied Cell & 1 Col Left
ActiveCell.Offset(0, -1).Select
'PLACE HOLDER
Selection.Value = "*"
'RANGE -- up to (& including) Supplier just pasted (Did not "select" --for some reason, so the next code of the same type will be a redundancy)
Range(Selection, Selection.End(xlUp)).Select
'Selection.AutoFill Destination:=Range("B466:B" & Range("C" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial xlPasteValues

'PLASTIC,COATING,ADHESIVE
Worksheets("Plastic,Coating,Adhesive data").Select
'(From Below, Go To) Last SUPPLIER-occupied Cell
Range("B2000").End(xlUp).Select
'Last occupied Cell + 1 Row Dn


ActiveCell.Offset(1, 0).Select

'Paste Supplier Name Once
ActiveCell.PasteSpecial xlPasteValues
'(From Below, Go To) Last APN-occupied Cell
Range("C2000").End(xlUp).Select
'Last occupied Cell & 1 Col Left
ActiveCell.(0, -1).Select
'PLACE HOLDER
Selection.Value = "*"
'RANGE -- up to (& including) Supplier just pasted (Did not "select" --for some reason, so the next code of the same type will be a redundancy)
Range(Selection, Selection.End(xlUp)).Select
'Selection.AutoFill Destination:=Range("B466:B" & Range("C" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial xlPasteValues

End If

MsgBox "Kindly Check out the Newly Created SYNTHESIS File! ", vbOKOnly, "DONE!"

Application.ScreenUpdating = True

End Sub

 

[Alex Blakenburg]

Is there anything in Column B that can't be overwritten ie can the supplier be copied to row 1 of the data to the last row of data (using column C to work out the last row of data ?)

 

[Alex Blakenburg]

See if this works for you:

Sub SUPPLIER_NAME_Fill_down_based_on_the_adjacent_row_mod()

    Dim wbCoverPg As Workbook, wbData As Workbook
    Dim aDataShtNames() As Variant
    Dim sDataSht As Variant
    Dim destSht As Worksheet
    Dim destLastRow As Long, destFirstRow As Long
    Dim CoverPgSupp As String
    
    Dim FileToOpen As Variant

    Application.ScreenUpdating = False
    
    Set wbData = ThisWorkbook
    aDataShtNames = Array("Fiber data", "Plastic,Coating,Adhesive data")

    
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & Select it", ButtonText:="Choose SAME SUPPLIER Dec' Sheet AGAIN")
    If FileToOpen <> False Then
        Set wbCoverPg = Application.Workbooks.Open(FileToOpen)
        CoverPgSupp = wbCoverPg.Sheets("Cover Page").Range("C6")
        
        For Each sDataSht In aDataShtNames
            Set destSht = wbData.Worksheets(sDataSht)
            With destSht
                destLastRow = .Range("C" & .Rows.Count).End(xlUp).Row
                destFirstRow = .Range("B" & destLastRow).End(xlUp).Row + 1
                .Range(.Cells(destFirstRow, "B"), .Cells(destLastRow, "B")).Value = CoverPgSupp
            End With
        Next sDataSht
    
    End If
    
    MsgBox "Kindly Check out the Newly Created SYNTHESIS File! :) ", vbOKOnly, "DONE!"
    
    Application.ScreenUpdating = True

End Sub

 

[Turk182]

Is there anything in Column B that can't be overwritten ie can the supplier be copied to row 1 of the data to the last row of data (using column C to work out the last row of data ?)

Hi Alex,
Unfortunately, the existing information in column B should not be overwritten; that information is always the names of suppliers who provide the parts listed in column C.

 

[Turk182]

Hi Alex,
Unfortunately, the existing information in column B should not be overwritten; that information is always the names of suppliers who provide the parts listed in column C.

See if this works for you:

Sub SUPPLIER_NAME_Fill_down_based_on_the_adjacent_row_mod()

    Dim wbCoverPg As Workbook, wbData As Workbook
    Dim aDataShtNames() As Variant
    Dim sDataSht As Variant
    Dim destSht As Worksheet
    Dim destLastRow As Long, destFirstRow As Long
    Dim CoverPgSupp As String
   
    Dim FileToOpen As Variant

    Application.ScreenUpdating = False
   
    Set wbData = ThisWorkbook
    aDataShtNames = Array("Fiber data", "Plastic,Coating,Adhesive data")

   
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & Select it", ButtonText:="Choose SAME SUPPLIER Dec' Sheet AGAIN")
    If FileToOpen <> False Then
        Set wbCoverPg = Application.Workbooks.Open(FileToOpen)
        CoverPgSupp = wbCoverPg.Sheets("Cover Page").Range("C6")
       
        For Each sDataSht In aDataShtNames
            Set destSht = wbData.Worksheets(sDataSht)
            With destSht
                destLastRow = .Range("C" & .Rows.Count).End(xlUp).Row
                destFirstRow = .Range("B" & destLastRow).End(xlUp).Row + 1
                .Range(.Cells(destFirstRow, "B"), .Cells(destLastRow, "B")).Value = CoverPgSupp
            End With
        Next sDataSht
   
    End If
   
    MsgBox "Kindly Check out the Newly Created SYNTHESIS File! :) ", vbOKOnly, "DONE!"
   
    Application.ScreenUpdating = True

End Sub

Hi Alex, thank you very much!
Your code is working consistently; the very strange thing about my previous code is that it would work perfectly for a short while..., and then – for whatever reason – would start malfunctioning in the way described earlier....
Would you happen to know what in my code was causing the problem (it would be very interesting to know)?
Thx again!
Turk182

 

[Turk182]

See if this works for you:

Sub SUPPLIER_NAME_Fill_down_based_on_the_adjacent_row_mod()

    Dim wbCoverPg As Workbook, wbData As Workbook
    Dim aDataShtNames() As Variant
    Dim sDataSht As Variant
    Dim destSht As Worksheet
    Dim destLastRow As Long, destFirstRow As Long
    Dim CoverPgSupp As String
   
    Dim FileToOpen As Variant

    Application.ScreenUpdating = False
   
    Set wbData = ThisWorkbook
    aDataShtNames = Array("Fiber data", "Plastic,Coating,Adhesive data")

   
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & Select it", ButtonText:="Choose SAME SUPPLIER Dec' Sheet AGAIN")
    If FileToOpen <> False Then
        Set wbCoverPg = Application.Workbooks.Open(FileToOpen)
        CoverPgSupp = wbCoverPg.Sheets("Cover Page").Range("C6")
       
        For Each sDataSht In aDataShtNames
            Set destSht = wbData.Worksheets(sDataSht)
            With destSht
                destLastRow = .Range("C" & .Rows.Count).End(xlUp).Row
                destFirstRow = .Range("B" & destLastRow).End(xlUp).Row + 1
                .Range(.Cells(destFirstRow, "B"), .Cells(destLastRow, "B")).Value = CoverPgSupp
            End With
        Next sDataSht
   
    End If
   
    MsgBox "Kindly Check out the Newly Created SYNTHESIS File! :) ", vbOKOnly, "DONE!"
   
    Application.ScreenUpdating = True

End Sub

Hi Alan, your code is still working just fine. I just want to understand at least one characteristic of my code that may have caused this error. Here is a possible connection (that I do not understand at all):
I was doing some testing on the spreadsheets, and something strange (at least to me) happened: Every time I removed the heading from column B, my code worked fine. Every time I placed a heading in column B, the code "went off script", overwriting the heading with the name of the supplier. Even when I inserted a new destination sheet, it made the same odd error--but only when I put a heading in column B (the "type" of heading did not matter: I used single words, multiple words, numbers, and even just spaces; in every case, unless the heading in column B was completely blank the macro overwrote the heading with the supplier name).
Have you seen something like this before, or have any idea what may have caused this???

 

[Alex Blakenburg]

The code you sent me in post # 3 had this line it under Plastic, Coating which had to be corrected.

ActiveCell(0, -1).Select

Should be

ActiveCell(0, -1).Select

After making that correction and running your code I had the opposite experience.
If there was a Heading in Column B then it worked fine.
If there was no heading then whether it worked depended on what line the data started.
This is because this line Range("B2000").End(xlUp).Select without a heading takes it to the "bottom of any previous data" OR if there is nothing above it, it goes to Row 1. This means your paste will start on the wrong row (unless your data happens to have started on Row 2)

You just need to understand what XlUP & XlDOWN do. If you are in a range of non-blank cells it takes you to the last non-blank cell.
If you are in a blank cell it will take you to the first non-blank cell.

If you comment out the line Application.Screenupdating = False and then use <F8> to step through the code you will

If you still want me to look into your heading issue and can't figure it out from the above, you will need to resend me the code you are currently using and please use the VBA button placing the code at the insertion point. The anove indicates it has changed since post #3.
A view of what row your data is starting on would also be helpful.
Hopefully using the above you will have already have worked it out.