G
Guest
I am a VBA beginner and very eager to learn this stuff. What a great forum!
I have a Worksheet named "Global Production Schedule" in Workbook1 that has
several rows with Sales Order numbers Column A and there ship dates in Column
K. When the order is shipped the user highlights the ship date cell yellow.
At the end of the day I want the user to be able to click a button, then the
highlighted cell rows are cut and then pasted into Sheets("sheet1") Workbook2
named "Archive". The code I have is not working and I'm not sure why. Feel
free to change anything, because this code could be seriously incorrect.
NOTE: The button to call this macro is in a custom toolbar I made and the
macro is located in my personal workbook because the global schedule file
name changes everyday. Here is what I have so far:
Sub SendToArchive()
Dim LastRow As Long, InsertRow As Long, FinalRow As Long
Dim wsArchive As Worksheet, wsGlobal As Worksheet
Dim wbArchive As Workbook, wbGlobal As Workbook
Dim fName As Variant
'Current worksheet with highlighted cells
wsGlobal = ThisWorkbook.Sheets("Global Production Schedule")
'Message to prompt user to select the Archive file
Msg1 = MsgBox("Choose the Archive file you want the selected Sales Orders to
go too.")
'User selected Archive File name
fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls")
If fName1 = False Then
Exit Sub
Else
Set wbArchive = Workbooks.Open(fName)
End If
Msg2 = MsgBox("Are you sure you want to move highlighted Sales Orders from "
& NAME OF GLOBAL WORKBOOK & " to " & NAME OF ARCHIVE WORKBOOK & " ?",
vbOKCancel)
If Msg1 <> vbOK Then Exit Sub
Set wsArchive = wbArchive.Sheets("Archive")
LastRow = wsArchive.Cells(Rows.Count, "A").End(xlUp).Row
InsertRow = LastRow + 1
FinalRow = wsGlobal.Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To FinalRow
If Cells(i, 11).Interior.ColorIndex = 6 Then 'Yellow Cells
Cells(i, 11).EntireRow.Cut Destination:=wsArchive.Rows(InsertRow)
End If
Next i
Windows(fName).Close SaveChanges:=Save
End Sub
I have a Worksheet named "Global Production Schedule" in Workbook1 that has
several rows with Sales Order numbers Column A and there ship dates in Column
K. When the order is shipped the user highlights the ship date cell yellow.
At the end of the day I want the user to be able to click a button, then the
highlighted cell rows are cut and then pasted into Sheets("sheet1") Workbook2
named "Archive". The code I have is not working and I'm not sure why. Feel
free to change anything, because this code could be seriously incorrect.
NOTE: The button to call this macro is in a custom toolbar I made and the
macro is located in my personal workbook because the global schedule file
name changes everyday. Here is what I have so far:
Sub SendToArchive()
Dim LastRow As Long, InsertRow As Long, FinalRow As Long
Dim wsArchive As Worksheet, wsGlobal As Worksheet
Dim wbArchive As Workbook, wbGlobal As Workbook
Dim fName As Variant
'Current worksheet with highlighted cells
wsGlobal = ThisWorkbook.Sheets("Global Production Schedule")
'Message to prompt user to select the Archive file
Msg1 = MsgBox("Choose the Archive file you want the selected Sales Orders to
go too.")
'User selected Archive File name
fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls")
If fName1 = False Then
Exit Sub
Else
Set wbArchive = Workbooks.Open(fName)
End If
Msg2 = MsgBox("Are you sure you want to move highlighted Sales Orders from "
& NAME OF GLOBAL WORKBOOK & " to " & NAME OF ARCHIVE WORKBOOK & " ?",
vbOKCancel)
If Msg1 <> vbOK Then Exit Sub
Set wsArchive = wbArchive.Sheets("Archive")
LastRow = wsArchive.Cells(Rows.Count, "A").End(xlUp).Row
InsertRow = LastRow + 1
FinalRow = wsGlobal.Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To FinalRow
If Cells(i, 11).Interior.ColorIndex = 6 Then 'Yellow Cells
Cells(i, 11).EntireRow.Cut Destination:=wsArchive.Rows(InsertRow)
End If
Next i
Windows(fName).Close SaveChanges:=Save
End Sub