Macro to copy row based on value into new sheet of same name

F

frankjh19701

I have a large Excel worksheet with info sorted by date. The columns
from left to right, are "Date", "Origin", "Employee", "Vehicle #"
"Product Count", and "Park Location."

What I'm looking for is a Macro to COPY the entire row from anothe
workbook's "Main" sheet (on the server) based on "Vehicle #" and PAST
the row into a new worksheet in another workbook and name the ne
worksheet the "Vehicle #." Auto sort the data by date as well.

I've been using:


Sub Sorting()

Dim sh2 As Worksheet, finalrow As Long
Dim i As Long, lastrow As Long
Set sh2 = Sheets("160")
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If Cells(i, 1).Value = "160" Then
lastrow = sh2.Cells(Cells.Rows.Count, 1).End(xlUp).Row
Cells(i, 1).EntireRow.Copy Destination:=sh2.Cells(lastrow + 1, 1)

End If
Next i
End Sub

But this only works if I copy the "Main" sheet from the externa
workbook and paste it into the workbook I'm using. And I have t
manually change the "Vehicle #."

Any/all assistance would be greatly appreciated.

Thank yo
 
N

Nathan Liebke

Something like this might get you started:

Dim MainWorkBook As Workbook
Dim MainSheet As Worksheet
Dim intRow As Integer
Dim intInsertRow As Integer
Dim VehicleNumber As String
Dim xls As Worksheet
Dim SheetFound As Boolean

' Open up your new workbook
Set MainWorkBook = Workbooks.Open("D:\Main.xls")
Set MainSheet = MainWorkBook.Sheets("Main")

' Loop through all rows (Ignore row 1)
For intRow = 2 To MainSheet.UsedRange.Rows.Count
VehicleNumber = MainSheet.Cells(intRow, 4)
If VehicleNumber <> "" Then
SheetFound = False
' Look for the matching sheet in the current workbook
For Each xls In ThisWorkbook.Sheets
' If the names match, continue
If xls.Name = VehicleNumber Then
SheetFound = True
Exit For
End If
Next xls

' If the sheet isn't found, create a new one
If Not SheetFound Then
Set xls = ThisWorkbook.Sheets.Add
xls.Name = VehicleNumber
' Put headers in
xls.Cells(1, 1) = "Date"
End If

' Insert new row
intInsertRow = xls.Cells(Cells.Rows.Count, 1).End(xlUp).Row
MainSheet.Cells(intRow, 1).EntireRow.Copy Destination:=xls.Cells(intInsertRow + 1, 1)


End If
Next intRow

MainWorkBook.Close

' Sort sheets
For Each xls In ThisWorkbook.Sheets
If xls.UsedRange.Rows.Count > 1 Then
xls.Unprotect
xls.UsedRange.Sort Key1:=xls.Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
Next xls
 
F

frankjh19701

I get an error at the Set main workbook - COMPILE ERROR: INVALID OUTSID
PROCEDURE"
 
N

Nathan Liebke

I get an error at the Set main workbook - COMPILE ERROR: INVALID OUTSIDE

PROCEDURE"

Hmmm... I assume you changed the spreadsheet name to your location. Is the spreadsheet password protected?
 
F

frankjh19701

No, it's not password protected. I tried saving it to the local Har
Drive (C) and I even saved the file from the server it has to referenc
to the local hard drive (C).

I'm new at macros and I want to get better. Any ideas on where and wha
to do next?

Frank
 
F

frankjh19701

frankjh19701;1607631 said:
No, it's not password protected. I tried saving it to the local Har
Drive (C) and I even saved the file from the server it has to referenc
to the local hard drive (C).

I'm new at macros and I want to get better. Any ideas on where and wha
to do next?

Frank

No, it's not password protected. I tried saving it to the local Har
Drive (C) and I even saved the file from the server it has to referenc
to the local hard drive (C).

I'm new at macros and I want to get better. Any ideas on where and wha
to do next?

Fran
 
N

Nathan Liebke

No, it's not password protected. I tried saving it to the local Hard

Drive (C) and I even saved the file from the server it has to reference

to the local hard drive (C).



I'm new at macros and I want to get better. Any ideas on where and what

to do next?



Frank

Can you show me all of the code you have? Also, what version of Excel do you have?
 
F

frankjh19701

Dim sh2 As Worksheet, finalrow As Long
Dim i As Long, lastrow As Long
Set sh2 = Sheets("NJ Deliveries")
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If Cells(i, 14).Value = "NJ to NJ" Then
lastrow = sh2.Cells(Cells.Rows.Count, 1).End(xlUp).Row
Cells(i, 1).EntireRow.Copy Destination:=sh2.Cells(lastrow + 1, 1)

End If
Next i

Is the code I started with. I want to modify it to auto sort th
comlumn with the names. It's column # 16. I'm using Excel 2010.

Also, I would like to make mulitple macros run when the file is opened
how can I do that without combining macros or is combining them the bes
choice?

Also, I would like to write a Macro to pull the data from a file on ou
server, copy the data from there, and import it into a workbook on m
local system. How can I do that?

Also, I would like the macro to create a sheet to copy the informatio
to within the workbook if a sheet of the searched for value isn'
already named. How can that be done?

Thank you again for your assistance
 
B

Ben McClave

Frank,

I think that Nathan's routine looks promising for nearly all of your needs.You are probably getting the "Invalid Outside Procedure" message because the code you're using is not within a procedure (a Sub or a Function). A quick fix should be to add a sub name, followed by Nathan's code and then "End Sub". For example:

Sub GetData()

'(Nathan's code from earlier post)

End Sub

When I took Nathan's original code without a Sub name, I received the same error on the same line. But adding "Sub GetData()" and ending with "End Sub" caused no errors for me.

As for the question about running multiple macros upon opening, you could use the "Workbook_Open" event to trigger the macros in the order you specify.. To do so, paste something along these lines into your "ThisWorkbook" module for the workbook in question:

Private Sub Workbook_Open()

Call MyMacro1
Call MyMacro2

End Sub

where "MyMacro1" and "MyMacro2" are the macros you wish to execute upon opening.

Hope this helps.

Ben
 
F

frankjh19701

Thanks Ben.

I got the code to work after I removed the DIM after the first one.
still need to figure out how to get teh macro to create a new sheet if
sheet with the name it searched for didn't exist.

After that, I would like to run a macro that would subtotal eac
worksheet by amount and location.

Any ideas?

Thank you again for Nathan and your assistanc
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top