0

Good day all experts,

I ran into this problem that the macro will stop when using shortcut key (I set to ctrl+shift+x) to run, but it will be smooth if I run each line one by one by pressing F8 in VBA window. After searching for all the relative posts on the forum, I still can't find (or probably not understand the solution) of what causes this problem since I am very new to VBA. The macro stops right after line" Set Wb2 = Workbooks.Open("\10.60.177.66\pm\DC\Daily shipping summary" & NM & ".xlsx")" It does open the file, but it stops there.

Maybe it is due to the file is still opening? I would really appreciate if someone can give me a solution. Here's the full code I wrote:

Sub ShippingReport()
'
' ShippingReport 巨集
'
' 快速鍵: Ctrl+Shift+X
'
Dim Wb1 As Object
Dim Wb2 As Object
Application.ScreenUpdating = False
Set Wb1 = ActiveWorkbook
Sheets("FXN TPE ---Shipping Report").Select
NM = InputBox("Insert shipping summary file name") 'ask the user for the file name
Set Wb2 = Workbooks.Open("\\10.60.177.66\pm\DC\Daily shipping summary\" & NM & ".xlsx")
Wb2.Sheets("工廠").Copy After:=Wb1.Sheets("SheetA")
Wb2.Sheets("PCBA to Hub").Copy After:=Wb1.Sheets("工廠")
Wb2.Close SaveChanges:=False

Dim dt, d1 As Variant

dt = InputBox("Enter the starting date(非2022/12/12格式不可執行)") 'ask the user for the starting date
dt = DateValue(dt)
d1 = dt + 1
d2 = d1 + 1
d3 = d2 + 1
d4 = d3 + 1
d5 = d4 + 1
d6 = d5 + 1
d7 = d6 + 1

Sheets("SheetA").Cells.Clear
Sheets("工廠").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 1 To FinalRow
        ' Decide if to copy based on column D
        ThisValue = Cells(x, 1).Value
        If ThisValue = dt Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("工廠").Select
        ElseIf ThisValue = d1 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("工廠").Select
        ElseIf ThisValue = d2 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("工廠").Select
        ElseIf ThisValue = d3 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("工廠").Select
        ElseIf ThisValue = d4 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("工廠").Select
        ElseIf ThisValue = d5 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("工廠").Select
        ElseIf ThisValue = d6 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("工廠").Select
        ElseIf ThisValue = d7 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("工廠").Select
        End If
    Next x
Sheets("PCBA to Hub").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 1 To FinalRow
        ' Decide if to copy based on column D
        ThisValue = Cells(x, 1).Value
        If ThisValue = dt Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("PCBA to Hub").Select
        ElseIf ThisValue = d1 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("PCBA to Hub").Select
        ElseIf ThisValue = d2 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("PCBA to Hub").Select
        ElseIf ThisValue = d3 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("PCBA to Hub").Select
        ElseIf ThisValue = d4 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("PCBA to Hub").Select
        ElseIf ThisValue = d5 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("PCBA to Hub").Select
        ElseIf ThisValue = d6 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("PCBA to Hub").Select
        ElseIf ThisValue = d7 Then
            Cells(x, 1).Resize(1, 12).Copy
            Sheets("SheetA").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("PCBA to Hub").Select
        End If
    Next x
Sheets("FXN TPE ---Shipping Report").Select
    FinalRowB = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("SheetA").Select
If Range("A2").Value = "" Then
    Response = MsgBox("No data in selected period found", vbOKOnly, "無出貨資料")
    Else
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To FinalRow
        Cells(x, 1).Copy
        Sheets("FXN TPE ---Shipping Report").Select
        NextRowB = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(NextRowB, 2).PasteSpecial Paste:=xlPasteValues
        Cells(NextRowB, 3) = Cells(NextRowB, 2).Value + 10
        Cells(NextRowB, 1) = "PO"
        Sheets("SheetA").Select
        Cells(x, 9).Copy
        Sheets("FXN TPE ---Shipping Report").Select
        Cells(NextRowB, 4).PasteSpecial Paste:=xlPasteValues
            If Cells(NextRowB, 4) = "GDL" Then
            Cells(NextRowB, 5) = "PCE PARAGON SOLUTIONS (MEXICO) SA DE CV"
            Else: Cells(NextRowB, 5) = Cells(NextRowB, 4)
            End If
        Sheets("SheetA").Select
        Cells(x, 2).Copy
        Sheets("FXN TPE ---Shipping Report").Select
        Cells(NextRowB, 6).PasteSpecial Paste:=xlPasteValues
        Sheets("SheetA").Select
        Cells(x, 3).Copy
        Sheets("FXN TPE ---Shipping Report").Select
        Cells(NextRowB, 7).PasteSpecial Paste:=xlPasteValues
            If Cells(NextRowB, 7) = "1A620KP00-600-G-B+31" Then
            Cells(NextRowB, 7) = "1A620KP00-600-G"
            Cells(NextRowB, 8) = "Hanuman EVT Motherboard"
            ElseIf Cells(NextRowB, 7) = "1A620P600-600-G-B+30" Then
            Cells(NextRowB, 7) = "1A620P600-600-G"
            Cells(NextRowB, 8) = "Hanuman EVT Midplane"
            ElseIf Cells(NextRowB, 7) = "1A626DA00-600-G-B+30" Then
            Cells(NextRowB, 7) = "1A626DA00-600-G"
            Cells(NextRowB, 8) = "Hanuman EVT Riser"
            ElseIf Cells(NextRowB, 7) = "1A626DE00-600-G-B+30" Then
            Cells(NextRowB, 7) = "1A626DE00-600-G"
            Cells(NextRowB, 8) = "Hanuman PVT Midplane"
            ElseIf Cells(NextRowB, 7) = "1A626DF00-600-G-B+31" Then
            Cells(NextRowB, 7) = "1A626DF00-600-G"
            Cells(NextRowB, 8) = "Hanuman PVT Motherboard"
            ElseIf Cells(NextRowB, 7) = "1A6288F00-600-G-B+31" Then
            Cells(NextRowB, 7) = "1A6288F00-600-G"
            Cells(NextRowB, 8) = "Hanuman EVT UPDB"
            ElseIf Cells(NextRowB, 7) = "1A62FMM00-600-G-B+A0" Then
            Cells(NextRowB, 7) = "1A62FMM00-600-G"
            Cells(NextRowB, 8) = "Hanuman PVT UPDB"
            ElseIf Cells(NextRowB, 7) = "1A62FMM00-600-G-B+30" Then
            Cells(NextRowB, 7) = "1A62FMM00-600-G"
            Cells(NextRowB, 8) = "Hanuman PVT UPDB"
            ElseIf Cells(NextRowB, 7) = "1A62FMP00-600-G+30" Then
            Cells(NextRowB, 7) = "1A62FMP00-600-G"
            Cells(NextRowB, 8) = "Hanuman PVT UPDB"
            ElseIf Cells(NextRowB, 7) = "1A62FR300-600-G-B+30" Then
            Cells(NextRowB, 7) = "1A62FR300-600-G"
            Cells(NextRowB, 8) = "Hanuman PVT Riser"
            End If
        Sheets("SheetA").Select
            DAT = Cells(x, 5)
            If Len(DAT) = 10 Then
            Cells(x, 5).Copy
            Sheets("FXN TPE ---Shipping Report").Select
            Cells(NextRowB, 10).PasteSpecial Paste:=xlPasteValues
            End If
        Sheets("SheetA").Select
        Cells(x, 4).Copy
        Sheets("FXN TPE ---Shipping Report").Select
            If Cells(NextRowB, 7) = "1A620KP00-600-G" Then
            Cells(NextRowB, 13) = "1810.52"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            ElseIf Cells(NextRowB, 7) = "1A620P600-600-G" Then
            Cells(NextRowB, 13) = "276.06"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            ElseIf Cells(NextRowB, 7) = "1A626DA00-600-G" Then
            Cells(NextRowB, 13) = "27.63"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            ElseIf Cells(NextRowB, 7) = "1A626DE00-600-G" Then
            Cells(NextRowB, 13) = "276.06"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            ElseIf Cells(NextRowB, 7) = "1A626DF00-600-G" Then
            Cells(NextRowB, 13) = "1810.52"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            ElseIf Cells(NextRowB, 7) = "1A6288F00-600-G" Then
            Cells(NextRowB, 13) = "180"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            ElseIf Cells(NextRowB, 7) = "1A62FMM00-600-G" Then
            Cells(NextRowB, 13) = "180"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            ElseIf Cells(NextRowB, 7) = "1A62FMP00-600-G" Then
            Cells(NextRowB, 13) = "180"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            ElseIf Cells(NextRowB, 7) = "1A62FR300-600-G" Then
            Cells(NextRowB, 13) = "20.32"
            Cells(NextRowB, 13).Interior.Color = RGB(255, 125, 125)
            End If
        Cells(NextRowB, 9).PasteSpecial Paste:=xlPasteValues
        Cells(NextRowB, 14) = Cells(NextRowB, 9) * Cells(NextRowB, 13)
        Cells(NextRowB, 16) = "Air"
        Cells(NextRowB, 17) = "DB Schenker"
        Sheets("SheetA").Select
        Cells(x, 8).Copy
        Sheets("FXN TPE ---Shipping Report").Select
        Cells(NextRowB, 18).PasteSpecial Paste:=xlPasteValues
            If Cells(NextRowB, 4) = "GDL" Then
            Cells(NextRowB, 15) = "EXW"
            ElseIf Cells(NextRowB, 4) = "DBS HUB - CVG" Then
            Cells(NextRowB, 15) = "DDP"
            ElseIf Cells(NextRowB, 4) = "DBS HUB - SLC" Then
            Cells(NextRowB, 15) = "DDP"
            ElseIf Cells(NextRowB, 4) = "DBS HUB - DUB" Then
            Cells(NextRowB, 15) = "DAP"
            ElseIf Cells(NextRowB, 4) = "DBS HUB - SIN" Then
            Cells(NextRowB, 15) = "DAP"
            End If
        Cells(NextRowB, 19) = "N"
        Sheets("SheetA").Select
    Next x
End If
Application.DisplayAlerts = False
Wb1.Sheets("工廠").Delete
Wb1.Sheets("PCBA to Hub").Delete
Application.DisplayAlerts = True
Response2 = MsgBox("Do not forget to check Unit Price", vbOKOnly, "程式未填單價")
Sheets("FXN TPE ---Shipping Report").Select
Application.ScreenUpdating = True
End Sub
  • I've tried to add a timer to delay the whole process right after the problematic line, however, the timer didn't even initiate so I guess the macro had stopped already.
  • I've also tried "DoEvents" but later found that isn't the problem I aim to solve. Thank you for anyone responding and I will reply to everyone!
braX
  • 11,506
  • 5
  • 20
  • 33
HarrisonYang
  • 1
  • 1
    I have not reviewed your code in detail, but I strongly suggest reworking your code to [avoid using `Select` and `Activate`](https://stackoverflow.com/a/10717999/4717755) and to make sure your [references are fully qualified](https://riptutorial.com/excel-vba/example/5110/qualifying-references). I suspect that your code stops when the `ActiveWorkbook` changes to the newly opened workbook. – PeterT Dec 29 '22 at 01:43
  • @PeterT Thank you very, very much for your reply! I did make a mess on using too many Select and Activate... However I see what you mention about the ActiveWorkbook and got confused a bit on the solution. I have my macro running on personal file so that I can run on other files, if I use ThisWorkbook then it will refer back to the personal file. If trying to name the file it generates more problems since the file name will be different every time (file name has date). Do you mind enlighten us? I'm a Taiwanese so the English might be weird sometimes :P – HarrisonYang Dec 29 '22 at 05:51

1 Answers1

0

This is an UNTESTED example!!

The code below is an example of how to refactor your code that includes several things which may help:

  1. Using more descriptive names for the variables. Doing this can help to self-document your code and make your references much clearer.
  2. Error checking around opening the summary workbook. This may be your problem (or maybe not), but this type of check makes sure your code executes cleanly and informs the user what has happened.
  3. Your whole first loop is completely redundant in code, each branch in your If statement is a repeat of the code above. It can be replaced by the simple loop shown here.
  4. Notice the use of Option Explicit. Always turn this on and use it.

This example is incomplete, but it shows some of what I referred to in my comment above. Hopefully this will help to solve your problem.

Option Explicit

Sub NewShippingReport()
    Dim reportWB As Workbook
    Set reportWB = ActiveWorkbook
    
    Dim summaryFilename As String
    Dim summaryWB As Workbook
    summaryFilename = InputBox("Insert shipping summary file name")
    
    On Error Resume Next
    Set summaryWB = Workbooks.Open("\\10.60.177.66\pm\DC\Daily shipping summary\" & _
                                   summaryFilename & ".xlsx")
    If summaryWB Is Nothing Then
        MsgBox "ERROR: unable to open the summary file at " & _
               summaryFilename, vbCritical + vbOKOnly
        Exit Sub
    End If
    On Error GoTo 0
    
    summaryWB.Sheets("Factory").Copy After:=reportWB.Sheets("SheetA")
    summaryWB.Sheets("PCBA to Hub").Copy After:=reportWB.Sheets("Factory")
    summaryWB.Close SaveChanges:=False
    
    Dim userInput As String
    userInput = InputBox("Enter the starting date(?2022/12/12??????)")
    If IsDate(userInput) Then
        MsgBox "ERROR: you must enter a valid date", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    Dim startDate As Date
    startDate = DateValue(userInput)
    
    Dim factoryReport As Worksheet
    Dim sheetA As Worksheet
    Set factoryReport = reportWB.Sheets("Factory")
    Set sheetA = reportWB.Sheets("SheetA")
    
    sheetA.Cells.Clear
    Dim lastReportRow As Long
    lastReportRow = factoryReport.Cells(factoryReport.Rows.Count, 1).End(xlUp).Row
    
    Dim i As Long
    For i = 1 To lastReportRow
        If i < DateAdd("d", 7, startDate) Then
            Dim lastSheetARow As Long
            lastSheetARow = sheetA.Cells(sheetA.Rows.Count, 1).End(xlUp).Row
            factoryReport.Cells(i, 1).Resize(1, 12).Copy
            sheetA.Cells(lastSheetARow + 1, 1).Paste
        End If
    Next i
    
End Sub
PeterT
  • 8,232
  • 1
  • 17
  • 38
  • Thank you very much as I looked into your code and was staggered by the simplicity of the code. I learnt so much and will definitely use "Option Explicit" to force myself to name those variables. I just copied your code and might tweak a little bit this week to see if it works as intended :) Regarding the error, I found that by setting shortcut key "ctrl+shift+d" makes the code stop after opening a file, after changing to "ctrl+d" completely fixes the problem. Later I found another post talking about this weird bug and seems the only solution is change the shortcut key. – HarrisonYang Jan 03 '23 at 06:08
  • I will also try to revise my whole macro by using the names you showed, I can tell it will run a lot faster than it is currently. I couldn't thank you more as I am happy and grateful to see there are enthusiasts willing to devote their time to help new VBA learners like I do. Thanks again! – HarrisonYang Jan 03 '23 at 06:14
  • It seems an error will occur at the bottom of the code `sheetA.Cells(lastSheetARow + 1, 1).Paste` The error states "The object doesn't support this property or method" It seems all variables have been assigned and I just couldn't figure out what the problem is... – HarrisonYang Jan 03 '23 at 08:42
  • My bad on the `Paste` -- change it to `PasteSpecial`. – PeterT Jan 03 '23 at 14:21