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

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 another workbook's "Main" sheet (on the server) based on "Vehicle #" and PASTE the row into a new worksheet in another workbook and name the new 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 external workbook and paste it into the workbook I'm using. And I have to manually change the "Vehicle #."

Any/all assistance would be greatly appreciated.

Thank you

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

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

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

I'm stuck :(

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

On Wednesday, November 21, 2012 3:59:48 AM UTC+10, frankjh19701 wrote:
I get an error at the Set main workbook - COMPILE ERROR: INVALID OUTSIDE

PROCEDURE"



I'm stuck :(Nathan Liebke;1607518 Wrote:

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









--

frankjh19701

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

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

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

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

On Tuesday, November 27, 2012 3:25:07 AM UTC+10, frankjh19701 wrote:
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



Nathan Liebke;1607537 Wrote:

On Wednesday, November 21, 2012 3:59:48 AM UTC+10, frankjh19701 wrote:-

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

OUTSIDE



PROCEDURE"







I'm stuck :(Nathan Liebke;1607518 Wrote:

-

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-



















--



frankjh19701-



Hmmm... I assume you changed the spreadsheet name to your location. Is

the spreadsheet password protected?









--

frankjh19701

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

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 the 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 best choice?

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

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

Thank you again for your assistance.

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

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

Thanks Ben.

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

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

Any ideas?

Thank you again for Nathan and your assistance

O.K. I'm working on it again.

This time I'm trying to configure a way to do the same outcome to two different sheets in the same workbook and copy the correct information into a third.

For example,

Miles driven, vehicle # , and Date are in one sheet (Sheet 2) and Date, vehicle #, and gallons of fuel purchased are in another sheet (Sheet 3).

What I need is in another sheet (Vehicle #) copy the appropriate information found in the two different sheets and paste it into the third (Vehicle #) sheet.

Basically, combining the information sorted by date into the vehicle's unique sheet in the same workbook.

Any/all assistance would be greatly appreciated.

Thank you

Also,

I don't want to create duplicates or if I do - highlight the entire row that's been duplicated.

Thank you again