PDA

View Full Version : Copy Data from One Sheet to another Specific sheet



hurleycr
07-14-2016, 09:37 AM
I am editing a macro someone else made. They have created some code that is beyond my experience. That reads data from a column and creates new sheets based on the number of unique data points and then names the sheets after those data points.

I am now tasked with moving the actual data from the sheet in which his code reads to the correct tab.

I have tried a few things, but realized this is just above my Schoolin'.

any help would be great. This is his code that is creating the tabs.



'create new sheets
On Error GoTo ErrHandle
Dim vl As String
wb = ActiveWorkbook.Name
cnt = Application.WorksheetFunction.CountA(ActiveWorkbook.Sheets("Sheet1").Range("S:S"))
For i = 2 To cnt
vl = Workbooks(wb).Sheets("Sheet1").Cells(i, 19).Value
WS_Count = Workbooks(wb).Worksheets.Count
a = 0
For j = 1 To WS_Count
If vl = Workbooks(wb).Worksheets(j).Name Then
a = 1
Exit For
End If
Next
If a = 0 Then
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = vl
End If


Next

Since the source data varies in a great deal. It has to be able to "know" when to create tabs and not to.

This is a part of large string of code. I however, understand the rest.

thanks in advance.
c

hurleycr
07-14-2016, 01:00 PM
I am editing a macro someone else made. They have created some code that is beyond my experience. That reads data from a column and creates new sheets based on the number of unique data points and then names the sheets after those data points.

I am now tasked with moving the actual data from the sheet in which his code reads to the correct tab.

I have tried a few things, but realized this is just above my Schoolin'.

any help would be great. This is his code that is creating the tabs.



'create new sheets
On Error GoTo ErrHandle
Dim vl As String
wb = ActiveWorkbook.Name
cnt = Application.WorksheetFunction.CountA(ActiveWorkbook.Sheets("Sheet1").Range("S:S"))
For i = 2 To cnt
vl = Workbooks(wb).Sheets("Sheet1").Cells(i, 19).Value
WS_Count = Workbooks(wb).Worksheets.Count
a = 0
For j = 1 To WS_Count
If vl = Workbooks(wb).Worksheets(j).Name Then
a = 1
Exit For
End If
Next
If a = 0 Then
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = vl
End If


Next

Since the source data varies in a great deal. It has to be able to "know" when to create tabs and not to.

This is a part of large string of code. I however, understand the rest.

thanks in advance.
c


I have gotten this far but it isn't correct. It is mixing up the data from one tab to the next it. It gets it mostly correct. For instance on my first "Created Sheet 1" I expect there to be 15 records copied from the "All Data" tab to the new Created Sheet 1. Instead I get 10 of the ones I expected and then 7 of random others.

Thoughts?



'create new sheets
On Error GoTo ErrHandle
Dim vl As String
wb = ActiveWorkbook.Name
cnt = Application.WorksheetFunction.CountA(ActiveWorkbook.Sheets("Sheet1").Range("S:S"))
For i = 2 To cnt
vl = Workbooks(wb).Sheets("Sheet1").Cells(i, 19).Value
WS_Count = Workbooks(wb).Worksheets.Count
a = 0
For j = 1 To WS_Count
If vl = Workbooks(wb).Worksheets(j).Name Then
a = 1
Exit For
End If
Next
If a = 0 Then
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = vl
Sheets("Sheet1").Activate
Range("A1:V1").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets(vl).Activate
Range("A1").Select
ActiveSheet.Paste
End If
Next
Sheets("Sheet1").Activate
j = 2
old_val = Cells(2, 19).Value
For i = 3 To cnt
new_val = Cells(i, 19).Value

If old_val <> new_val Then
Range("A" & j & ":V" & i).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets(old_val).Activate
Range("A2").Select
ActiveSheet.Paste

Sheets("Sheet1").Activate

old_val = Cells(i + 1, 19).Value
j = i + 1
End If
Next

On Error GoTo ErrHandle

p45cal
07-15-2016, 03:09 AM
try (tested only a bit):
Dim Sht As Worksheet
With ActiveWorkbook
'On Error GoTo ErrHandle 'try to avoid - it hides errors you don't know occur.
Set SceSht = .Sheets("Sheet1")
cnt = Application.WorksheetFunction.CountA(SceSht.Range("S:S")) 'this may not be very reliable.
j = 2
For i = j To cnt + 1
If SceSht.Cells(j, 19).Value <> SceSht.Cells(i, 19).Value Then
Set Sht = Nothing
On Error Resume Next 'because the next line is guaranteed to error if the sheet doesn't exist.
Set Sht = .Sheets(SceSht.Cells(j, 19).Value)
On Error GoTo 0 'return to normal event handling.
If Sht Is Nothing Then 'create new sheet and add headers:
Set NewSht = .Sheets.Add(After:=ActiveSheet) 'dodgy
NewSht.Name = SceSht.Cells(j, 19).Value
SceSht.Range("A1:V1").SpecialCells(xlCellTypeVisible).Copy NewSht.Range("A1")
End If
'copy data:
SceSht.Range("A" & j & ":V" & i - 1).SpecialCells(xlCellTypeVisible).Copy .Sheets(SceSht.Cells(j, 19).Value).Range("A2")
j = i
End If
Next
End With
There are other ways to do this which may be more suitable.
There could be problems if the sheet names in column S are not sorted into groups because copied cells are always copied to row 2 of the desination sheet, overwriting any existing data. You can overcome this by sorting the source sheet on column S first (perhaps you already do this).
Because the data are always written to A2, if there are already data in the destination sheet (a sheet you haven't needed to add) then this data might be overwritten.

If you're still having problems, attach a dummy workbook.

hurleycr
07-15-2016, 06:36 AM
Wow that really improved the speed of the macro.

The sort was already ready there just before the Insert Sheets code.

I did a couple of run thru. It seems it is breaking with the last set of data. I will attached the sheets I am working with. I used dummy data because there is no reason to use the massive amount that I am testing it with and will end up using.

When the (My COPY spreadsheet) code runs there is an instance that it will ask for another spreadsheet (My Employee Report). That is attached as well with dummy data. You can see my notes through the code if that helps at all. Most of the beginning code isn't mine and should be mostly formatting stuff that I have not cleaned up yet.

I know the code is choppy, I just need a working copy before I try and clean it up. This is manual process right now and its killing us. FYI.... Its a considerable amount of data every day. sometimes twice a day.

I really appreciate your help. Feel Free to make any suggestions, I enjoy learning from you advanced users.

Thanx again.

p45cal
07-15-2016, 06:45 AM
It seems it is breaking with the last set of data.I haven't looked at your sheets yet but can you confirm that you've tested with the current version in my last message, since I change it a couple of times since originally posting (you can see the last edit time and reason in that post).

hurleycr
07-15-2016, 06:55 AM
I haven't looked at your sheets yet but can you confirm that you've tested with the current version in my last message, since I change it a couple of times since originally posting (you can see the last edit time and reason in that post).

This is the code I used on my last run through.
It runs great with the exception of the very last section of data points.


'P45cal Code
With ActiveWorkbook
Set SceSht = .Sheets("Sheet1")
'On Error GoTo ErrHandle 'try to avoid - it hides errors you don't know occur.
Dim vl As String
'create new sheets:
Dim Sht As Worksheet
cnt = Application.WorksheetFunction.CountA(SceSht.Range("S:S"))
For i = 2 To cnt
Set Sht = Nothing
On Error Resume Next 'next line is guaranteed to error if the sheet does not exist:
Set Sht = .Sheets(SceSht.Cells(i, 19).Value)
On Error GoTo 0 'return to normal error handling.
If Sht Is Nothing Then
Set NewSht = .Sheets.Add(After:=ActiveSheet) 'dodgy
NewSht.Name = SceSht.Cells(i, 19).Value
SceSht.Range("A1:V1").SpecialCells(xlCellTypeVisible).Copy NewSht.Range("A1")
End If
Next
'copy data:
j = 2
old_val = SceSht.Cells(2, 19).Value
For i = 3 To cnt
If old_val <> SceSht.Cells(i, 19).Value Then
SceSht.Range("A" & j & ":V" & i - 1).SpecialCells(xlCellTypeVisible).Copy .Sheets(old_val).Range("A2")
old_val = SceSht.Cells(i, 19).Value
j = i
End If
Next
End With

p45cal
07-15-2016, 07:25 AM
This is the code I used on my last run through.
It runs great with the exception of the very last section of data points.
Which plainly isn't the latest so try with that.

hurleycr
07-15-2016, 07:46 AM
Not sure how I missed that!!!!

Yeah that did it with the dummy data. I will try it will the actual data and see what happens.

Thanks a TON!!!

hurleycr
07-15-2016, 08:08 AM
Using the actual data is hangs right here with a Subscript out of range error. I do not see a difference in the actual data and the dummy data though. Other than the amount.


SceSht.Range("A" & j & ":V" & i - 1).SpecialCells(xlCellTypeVisible).Copy .Sheets(SceSht.Cells(j, 19).Value).Range("A2")

p45cal
07-15-2016, 12:07 PM
Using the actual data is hangs right here with a Subscript out of range error. I do not see a difference in the actual data and the dummy data though. Other than the amount.


SceSht.Range("A" & j & ":V" & i - 1).SpecialCells(xlCellTypeVisible).Copy .Sheets(SceSht.Cells(j, 19).Value).Range("A2")
This will probably be because SceSht.Cells(j, 19).Value is not a valid sheet name.
It could also be because the value of j and/or i.
When the code errors, choose Debug and in the Immediate pane type the next 3 lines, pressing Enter after each one:
?i
?j
? "]" & SceSht.Cells(j, 19).Value & "["

What do you get?

In the attached sheet, there's a macro. Try running it. It doesn't solve the above problem - that will still need to be sorted.

hurleycr
07-17-2016, 08:37 AM
Wow you really made that thing move!!

Still breaking. "Compile error: Method not valid without suitable object"

I inserted the code you suggested as follows:


Print i
Print j
Print "]" & SceSht.Cells(j, 19).Value & "["
.Range("A" & j & ":V" & i - 1).SpecialCells(xlCellTypeVisible).Copy .Parent.Sheets(.Cells(j, 19).Value).Range("A2")
j = i
End If

If you don't mind me asking so that I can learn a bit here as well, what is that code accomplishing?

Also, went through and examined the real data vs the dummy data. I spotted a small difference that I believe is causing the issue, didn't think about it because it happens very rarely. On occasion the real data will have values that are not assigned to leads. Causing the lookups to return #N/A.

I have addressed the issue that should resemble the data perfectly now.

I have also exported the code from the spreadsheet you attached and imported into this version.

The code:

.Range("M2").FormulaR1C1 = "=VLOOKUP(RC12,'C:\Users\Pascal\AppData\Local\Temp\[Copy of My Employee Report.xlsx]Format'!R2C2:R51C8,2,FALSE)"
Z = InStrRev(FormatFileName, "\")
zzz = Left(FormatFileName, Z) & "[" & Mid(FormatFileName, Z + 1)/

breaks if I try to use the dummy data after I exported it to this version. However, if I use it from the sheet you attached above. It runs brilliantly! I am assuming this is because it is referencing your user folder. I have little experience in code that goes to external sheets like this.

I am seriously impressed with how much faster it runs though!:clap::clap:


This will probably be because SceSht.Cells(j, 19).Value is not a valid sheet name.
It could also be because the value of j and/or i.
When the code errors, choose Debug and in the Immediate pane type the next 3 lines, pressing Enter after each one:
?i
?j
? "]" & SceSht.Cells(j, 19).Value & "["

What do you get?

In the attached sheet, there's a macro. Try running it. It doesn't solve the above problem - that will still need to be sorted.

p45cal
07-17-2016, 08:48 AM
I inserted the code you suggested as follows:


Print i
Print j
Print "]" & SceSht.Cells(j, 19).Value & "["


The code is not for inserting into the procedure, it's to execute in the Immediate pane (Ctrl + G if you can't see it) when the code errors and you should stick to ? not Print.

If you don't mind me asking so that I can learn a bit here as well, what is that code accomplishing?It will simply tell us what values are in those variables at the time it errors.

p45cal
07-17-2016, 08:58 AM
The code:
.Range("M2").FormulaR1C1 = "=VLOOKUP(RC12,'C:\Users\Pascal\AppData\Local\Temp\[Copy of My Employee Report.xlsx]Format'!R2C2:R51C8,2,FALSE)"
Z = InStrRev(FormatFileName, "\")
zzz = Left(FormatFileName, Z) & "[" & Mid(FormatFileName, Z + 1)/

breaks if I try to use the dummy data after I exported it to this version.The red line above I accidentally left in; delete it entirely. The formula it writes to that cell gets overwritten by another 3 lines later.

hurleycr
07-17-2016, 09:00 AM
Ah...Yes it was hidden.
The "?" changes in the debug screen to Print automatically.

In the Immediate screen however this is the result:

?i
11
?j
2
?"]"&SceSht.Cells(j,19).Value&"["
]0[

hurleycr
07-17-2016, 09:08 AM
That what I was thinking but wasn't sure.

FOrgot to add the new dummy files.

This adds a few records. You will see what I mean in the Employee file. Badges 60-65

p45cal
07-17-2016, 12:00 PM
Change:

.Range("A" & j & ":V" & i - 1).SpecialCells(xlCellTypeVisible).Copy .Parent.Sheets(.Cells(j, 19).Value).Range("A2")

to:

.Range("A" & j & ":V" & i - 1).SpecialCells(xlCellTypeVisible).Copy .Parent.Sheets(CStr(.Cells(j, 19).Value)).Range("A2")

hurleycr
07-17-2016, 04:54 PM
That works like a dream on the Dummy Data.

That changes the values to a string right? Which makes the object valid?

I will try it on the actual data set tomorrow at work!!!

Thanks for the help and the shared knowledge.


Thanks so much for the help.