Solved: Code to Move to next sheet

[James Niven]

Hi all,

There may be a simple solution to this, but I have spent sometime on it with only one sheet doing what I want.

Basically, I want to copy cells E34 to E47 to cells D34 to D47 and then clear contents of E34 to E47, then move to the next sheet down the line. I am only interested in sheets named "7046445-001" thru to "7046445-003". For the sake of file size I have left lots on the tabs of, but there will be on any given time up to 30 tabs ranging each in roughly 1500 rows each.

THere will be a second part to this question, but for now this listed above is my goal for now.

Here is the code I am using:

Sub MoveEndData()
'Declare variables
Dim sht As Worksheet

For Each sht In Worksheets(Array("7046445-001", "7046445-002", "7046445-003"))

Range("E34:E47").Copy Range("D34:D47")
Range("E34:E47").ClearContents
Exit For
Next sht
End Sub


Thanks

[GTO]

Hi James,

I didn't look at the workbook yet, but was curious as to why there's an 'Exit For' in there?

Mark

[Bob Phillips]

You also need to qualify with the sht object that you are iterating through



Sub MoveEndData()

'Declare variables
Dim sht As Worksheet

For Each sht In Worksheets(Array("7046445-001", "7046445-002", "7046445-003"))

sht.Range("E34:E47").Copy sht.Range("D34:D47")
sht.Range("E34:E47").ClearContents
Next sht

End Sub

[mdmackillop]

Based on your code

For Each sht In Worksheets(Array("7046445-001", "7046445-002", "7046445-003"))
sht.Range("E34:E47").Copy sht.Range("D3447")
sht.Range("E34:E47").ClearContents
Next sht



If you are doing this with many consecutive numbered sheets, loop the number; also Cut instead of Copy/Clear


Dim sht As Worksheet
Dim i As Long
For i = 1 To 3
Set sht = Sheets("7046445-" & Format(i, "000"))
sht.Range("E34:E47").Cut sht.Range("D3447")
Next i

[James Niven]

Thanks guys for the assistance you all offered, you truly know your code.
Ok, that's all working the way I want, now the second part of my issue.

As I mentioned earlier there are 30 plus regions 7046445-001 etc for the state of Texas where we have copiers. These spreadsheets are downloaded from a website once a month where we enter in the monthly meter count, in the past we have been entering in manually by lining up the serial number of two different spreadsheets and copying the impressions and pasting, very time consuming, up to 12 hours total process.

The sheet named "Download sheet" is taken from a database with all the states meter reads entered in along with the serial number.

I have linked download sheet to the blank column E on sheet 7046445-001 after moving over by using Vlookup and inserting the meter for black and white in the correct row and color in the correct row based on the value in column J "Type" and the serial numbers both equal the same. I have done this, run the formula down the column and I have the meters copied over.

My question is "How do I do all this by code after I move column E over to D and clear the contents of E, then enter in the value from download sheet?"

I have attached the effort from this morning along with some fine tuning I have done.

Here is the Vlookup formula I have been using linking it manually.

From Sheet 7046445-001

=IF('7046445-001'!J34="b/W ON COLOR",VLOOKUP(C34,'Download Sheet'!G:J,3,FALSE),IF('7046445-001'!J34="COLOR",VLOOKUP(C34,'Download Sheet'!G:J,4,FALSE),VLOOKUP(C34,'Download Sheet'!G:J,3,FALSE)))

This formula reads impressions from “Download Sheet” over to 7046445-001 based on the serial number in Column “C” on sheet 7046445-001, and if the serial number is found the impression in the 3rd column to the right of the serial number column is copied over to sheet 7046445-001.

I hope I have explained myself pretty well.

Thanks in advance for the replies.

James Niven
Cedar Creek.

[James Niven]

Hi All,

Are there any takers on this issue I am wanting solved?

Thanks

[mdmackillop]

I'll look at it this evening

[James Niven]

Hi Guys,

I have done a bit of some trying out different lines of code for my VLookup issue.
I don't quite understand how to reference the correct cells on the download sheet in my example to pull across the correct value beside B/W and Color meter for each serial number.

Can someone point me in the right direction?:banghead:

[GTO]

Hi James,

Patience brother, it can getto be a busy week sometimes :-) Anyways, hope you don't mind, but I think a step back is needed. The way you had lngLastRow being determined was just finding the last row w/a val on the ActiveSheet. I think you want to qualify this to check each sheet we're moving ("copying") and clearing vals on...

Also and optionally, w/formatted (borders/patterns/etc) sheets, I find it handier to just take the vals.

Finally, we are depending (hopefully okay) on a val in col one being req'd for ea record.


Sub MoveEndData_3()
Dim sht As Worksheet
Dim lngLastRow As Long, lngLastColumn As Long
Dim I As Long


'// This is finding the last row of whatever sheet is active; NOT necessarily the
'// sheet's last row you want.
' lngLastRow = Cells.Find(What:="*", After:=Cells(1, 1), SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
' lngLastColumn = Cells.Find(What:="*", After:=Cells(1, 1), SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column


For I = 1 To 3
Set sht = Sheets("7046445-" & Format(I, "000"))
With sht
'// Instead, let's set the last row to the sheet we are currently moving
'// (copying) stuff on... Also - changed to look in col A from last row on sheet to A34.
'//I think I may have over did it a bit, a little tired... but seems to work.
lngLastRow = .Range("A34:A" & .Cells(Rows.Count, 1).Row).Find(What:="*", _
After:=.Cells(Rows.Count, 1), SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
'// I'm not sure about which col to look in here, as it's not currently being used.
'lngLastColumn = .Cells.Find(What:="*", After:=.Cells(1, 1), SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column


'// Better yet, as we're not looking to overwrite borders, let's
'// just make one range contain the values of the other.
.Range("D34:D" & lngLastRow).Value = .Range("E34:E" & lngLastRow).Value
.Range("E34:E" & lngLastRow).ClearContents
End With
Next I
End Sub

Hope this makes sense and I haven't missed something. I'm worth [bleep] at formulas, but spotted this and figured you'd want to know.

As to your post #5, before addressing "building" the vlookup, I am unclear on this: I am presuming 'Download Sheet' is just as rec'd from the 'database'. Is this correct(?) and if so, what kind (Access/etc)?

Finally, how do the records from 'Download Sheet' get parsed to the various sheets?

Mark

[Paul_Hossler]

My two cents -- I'm guessing about some of your details, but there might something that gives you some ideas.

Basically, it goes throrough all your sheets that have the name formatted like '7046445-002', copies End to Start, and then goes down those rows to VLookup data from Download. I guessed at some logic (cols, etc.) so you might have to fix it.



Sub MoveEndData()

'Declare variables
Dim sht As Worksheet
Dim Col As Long
Dim rPrev As Range, rPrev1 As Range, rPrev2 As Range, rRow As Range
Dim rDownLoad As Range

Application.ScreenUpdating = False

Set rDownLoad = Worksheets("DownLoad Sheet").Range("G:J")

For Each sht In ThisWorkbook.Worksheets
With sht
If .Name Like "#######-###" Then
Set rPrev1 = .Cells(34, 5)
Set rPrev2 = .Cells(.Rows.Count, 5).End(xlUp)
Set rPrev = Range(rPrev1, rPrev2)
rPrev.Copy (sht.Cells(34, 4))
rPrev.ClearContents

For Each rRow In rPrev.EntireRow
If LCase(rRow.Cells(10).Value) = "color" Then
iCol = 4
Else
iCol = 3
End If

rRow.Cells(5).Value = 0
On Error Resume Next
rRow.Cells(5).Value = Application.WorksheetFunction.VLookup _
(rRow.Cells(3).Value, rDownLoad, iCol, False)
On Error GoTo 0
Next

End If
End With
Next

Application.ScreenUpdating = True


MsgBox "Macro has completed"

End Sub



Paul

[James Niven]

Hi Paul/Mark,

I thank you both for your input, sorry I have not got back to you all, I got side tracked on other projects. Paul, your code did exactly what was asked for and thank for for your time. I see Paul and Mark both have different approach to writing the main body of the code, both work for well.

Paul, I ran your code on the full blown spreadsheet today, let me set the scene.
The download sheet had 2550 rows of data exactly as I had in the example. I setup 11 tabs all with the same format as per the example, but the only difference was each sheet had ranging from 180 to 400 row of data in each of the sheets. After starting the macro there is a pause of about 3 seconds before you see the column move over then another 3 seconds pause before you see the column clear contents, then about 7 seconds per line as the Vlookup looks for the serial number on the Download Sheet in G and works its way down the column. So, it should be finished in roughly 15 minutes per sheet. I am guess it is the shear size of the download sheet, or is it something else.

Any comments are welcomed.

Thanks

James Niven
Cedar Creek, TX

[Paul_Hossler]

Didn't run that slow for me. Something must be happening. Download in the WB you posted only has 24 rows

Did you single step through it and see?

You can re-post the WB if you want. Maybe someone else has some ideas

1. Try to turn off calculation and events and see if that helps



Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False


'rest


Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True



2. Small typo Dim Col As Long should be Dim iCol As Long

3. In Col F you have formulas, and these will recalc:


=IF(ISBLANK(E34),0,E34-D34)


4. in Col K - Y on Download you have a lot formulas also - they require time recalcing also


=IF(ISERROR(VLOOKUP(G2,'7046445-001'!C:I,1,FALSE)),"",VLOOKUP(G2,'7046445-001'!C:I,1,FALSE))


I'd look at improving the macro to build the Yellow cells without having the VLookups


5. I added these to the macro, and added a VBA calculation for your Col F data


Sub MoveEndData()

'Declare variables
Dim sht As Worksheet
Dim iCol As Long
Dim rPrev As Range, rPrev1 As Range, rPrev2 As Range, rRow As Range
Dim rDownLoad As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set rDownLoad = Worksheets("DownLoad Sheet").Range("G:J")

For Each sht In ThisWorkbook.Worksheets
With sht
If .Name Like "#######-###" Then
Set rPrev1 = .Cells(34, 5)
Set rPrev2 = .Cells(.Rows.Count, 5).End(xlUp)
Set rPrev = Range(rPrev1, rPrev2)
rPrev.Copy (sht.Cells(34, 4))
rPrev.ClearContents

For Each rRow In rPrev.EntireRow
If LCase(rRow.Cells(10).Value) = "color" Then
iCol = 4
Else
iCol = 3
End If

rRow.Cells(5).Value = 0
On Error Resume Next
rRow.Cells(5).Value = Application.WorksheetFunction.VLookup _
(rRow.Cells(3).Value, rDownLoad, iCol, False)
On Error GoTo 0
rRow.Cells(6).Value = rRow.Cells(5).Value - rRow.Cells(4).Value
Next

End If
End With
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.ScreenUpdating = True


MsgBox "Macro has completed"

End Sub



Paul

[Paul_Hossler]

Taking a guess here, but on Download sheet, instead of having 2000 x 15 x 2 formulas, I thought maybe you could use just one column with the WS name of the SN in it, and build that col as part of the macro.

Some new lines marked with --------------------


Option Explicit
Sub MoveEndData()

'Declare variables
Dim sht As Worksheet
Dim iCol As Long
Dim rPrev As Range, rPrev1 As Range, rPrev2 As Range, rRow As Range
Dim rDownLoad As Range
Dim collWS_SN As New Collection '-------------------

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set rDownLoad = Worksheets("DownLoad Sheet").Range("G:J")

For Each sht In ThisWorkbook.Worksheets
With sht
If .Name Like "#######-###" Then
Set rPrev1 = .Cells(34, 5)
Set rPrev2 = .Cells(.Rows.Count, 5).End(xlUp)
Set rPrev = Range(rPrev1, rPrev2)
rPrev.Copy (sht.Cells(34, 4))
rPrev.ClearContents

For Each rRow In rPrev.EntireRow
If LCase(rRow.Cells(10).Value) = "color" Then
iCol = 4
Else
iCol = 3
End If

rRow.Cells(5).Value = 0
On Error Resume Next
rRow.Cells(5).Value = Application.WorksheetFunction.VLookup _
(rRow.Cells(3).Value, rDownLoad, iCol, False)
On Error GoTo 0
rRow.Cells(6).Value = rRow.Cells(5).Value - rRow.Cells(4).Value


'add to collection '-------------------
On Error Resume Next
Call collWS_SN.Add(sht.Name, rRow.Cells(3).Value)
On Error GoTo 0


Next

End If
End With
Next

'add WS to Download '-------------------
Worksheets("DownLoad Sheet").Columns(11).Delete
For Each rRow In Worksheets("DownLoad Sheet").Cells(1, 1).CurrentRegion.Rows
With rRow
If .Row = 1 Then
.Cells(1, 11).Value = "Worksheet"
Else
.Cells(1, 11).Value = "N/A"
On Error Resume Next
.Cells(1, 11).Value = collWS_SN(.Cells(1, 7).Value)
On Error GoTo 0
End If
End With
Next



'Restore settings


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.ScreenUpdating = True


MsgBox "Macro has completed"

End Sub


Just a thought

Paul

[James Niven]

Paul,

I looked at your first post dated lasted night and tried all your examples and suggestions, to no avail, still running slow!!

Then on your second example, your new lines of code did the trick. I believe as you mentioned the "Download Sheet" was recalculating all the columns and hence I believe this is why it was running slow. Once the macro ran and the code did the job on the download sheet, it was about 2 minutes from start to finish on all 11 sheets.
Its funny how something so simple, caused the slowness of the macro.

How do I insert into the code a message to say something like working on sheet "...", "this sheet now completed" and moving to the next one. I worked out how to do this but I don't want to hit OK button on message box to move to next sheet and do the same again, any thoughts?

Thanks so much for your assistance.

James Niven
Cedar Creek, TX

[Paul_Hossler]

Glad it's better

Inside the loops you could just add something like


If (.Row Mod 100) = 1 Then
Application.StatusBar = "Updating 'Download Sheet' Row " & _
.Row & " (" & Format(.Row / n, "#0%") & ")"
End If


and before you exit


Application.Statusbar = False


Paul

[James Niven]

Paul,

Thanks so much, that did the trick excellent.

I am now going to change to "Solved". I am total happy with this now.

Thanks so much for your assistance Paul and everyone else!!

I still have much too learn and with members such as you, you and others on the board are all good teachers.

Thanks

James Niven
Cedar Creek, TX