Need a busy macro

G

Guest

I have data in Col A & B,\. The data starts at line one and CURRENTLY goes to
line 214..but that will increase over time.
In order to better display this data I would like a micro that would display
all the data in 5 blocks accros the screen.
So The first FIFTH of Cao A & B would remain where it is
The second FIFTH would be copied to COL D & E(leaving a col for seperation)
the third fifth would be copied to col G & H
and the same until all the data was listed in 5 BLOCKS(A & B D & E G & H
J & K M & N)
Any assistance would be appreciated
Thanks
 
G

Guest

This code all goes into the worksheet's code module. To put it there,
right-click on the sheet's name tab and select [View Code] and then copy and
paste all of the code into it. If you end up with two "Option Explicit"
statements at the top, delete one of them.

To explain - there's one variable set up to determine if the 4 lists need to
be updated while using the sheet because you added/deleted row(s) in column
A. The _Deactivate event handler sets that variable to zero so that the
lists will be updated the next time you select the sheet after having
selected another sheet. The _Change() event handler determines if you've
added/deleted row(s) in column A.

The _Activate event actually does the work, so it'll always show current
information when you initially select that sheet.

The one thing that doesn't happen is that any changes made to existing data
in A or B won't be reflected in the 4 other groups until something causes an
update to those lists - simply choosing another sheet and returning to it
will refresh the lists.

Here's the code:

Option Explicit
Dim usedRowCount As Long

Private Sub Worksheet_Deactivate()
usedRowCount = 0
End Sub

Private Sub Worksheet_Activate()
Dim lastRow As Long
Dim sectionSize As Long
Dim startRow As Long
Dim endRow As Long
Dim sourceRange As Range
Dim destRange As Range

If Val(Left(Application.Version, 2)) < 12 Then
'in pre Excel 2007
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Else
'in Excel 2007 or later
lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
End If
If lastRow = usedRowCount Then
Exit Sub ' no new/deleted rows - but changes not updated
End If
Application.EnableEvents = False
usedRowCount = lastRow
sectionSize = Int(lastRow / 5) + 1
'clear out any previous results in extra columns
Range("D:E").ClearContents
Range("G:H").ClearContents
Range("J:K").ClearContents
Range("M:N").ClearContents
'pick a cutoff point: if fewer than 40 rows, don't do anything
If sectionSize < 40 Then
Exit Sub
End If
'begin at sectionSize+1 to 2*sectionSize
startRow = sectionSize + 1
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("D1:E" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("G1:H" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("J1:K" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("M1:N" & sectionSize)
destRange.Value = sourceRange.Value
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim currentLastRow As Long

If Target.Column > 2 Then
Exit Sub ' no change in columns A or B
End If
If Val(Left(Application.Version, 2)) < 12 Then
'in pre Excel 2007
currentLastRow = Range("A" & Rows.Count).End(xlUp).Row
Else
'in Excel 2007 or later
currentLastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
End If
If currentLastRow = usedRowCount Then
Exit Sub ' no new/deleted rows - but changes not updated
End If
'call Worksheet_Activate to update the lists
Worksheet_Activate

End Sub
 
G

Guest

That works REALLY well. Thanks very much

JLatham said:
This code all goes into the worksheet's code module. To put it there,
right-click on the sheet's name tab and select [View Code] and then copy and
paste all of the code into it. If you end up with two "Option Explicit"
statements at the top, delete one of them.

To explain - there's one variable set up to determine if the 4 lists need to
be updated while using the sheet because you added/deleted row(s) in column
A. The _Deactivate event handler sets that variable to zero so that the
lists will be updated the next time you select the sheet after having
selected another sheet. The _Change() event handler determines if you've
added/deleted row(s) in column A.

The _Activate event actually does the work, so it'll always show current
information when you initially select that sheet.

The one thing that doesn't happen is that any changes made to existing data
in A or B won't be reflected in the 4 other groups until something causes an
update to those lists - simply choosing another sheet and returning to it
will refresh the lists.

Here's the code:

Option Explicit
Dim usedRowCount As Long

Private Sub Worksheet_Deactivate()
usedRowCount = 0
End Sub

Private Sub Worksheet_Activate()
Dim lastRow As Long
Dim sectionSize As Long
Dim startRow As Long
Dim endRow As Long
Dim sourceRange As Range
Dim destRange As Range

If Val(Left(Application.Version, 2)) < 12 Then
'in pre Excel 2007
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Else
'in Excel 2007 or later
lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
End If
If lastRow = usedRowCount Then
Exit Sub ' no new/deleted rows - but changes not updated
End If
Application.EnableEvents = False
usedRowCount = lastRow
sectionSize = Int(lastRow / 5) + 1
'clear out any previous results in extra columns
Range("D:E").ClearContents
Range("G:H").ClearContents
Range("J:K").ClearContents
Range("M:N").ClearContents
'pick a cutoff point: if fewer than 40 rows, don't do anything
If sectionSize < 40 Then
Exit Sub
End If
'begin at sectionSize+1 to 2*sectionSize
startRow = sectionSize + 1
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("D1:E" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("G1:H" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("J1:K" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("M1:N" & sectionSize)
destRange.Value = sourceRange.Value
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim currentLastRow As Long

If Target.Column > 2 Then
Exit Sub ' no change in columns A or B
End If
If Val(Left(Application.Version, 2)) < 12 Then
'in pre Excel 2007
currentLastRow = Range("A" & Rows.Count).End(xlUp).Row
Else
'in Excel 2007 or later
currentLastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
End If
If currentLastRow = usedRowCount Then
Exit Sub ' no new/deleted rows - but changes not updated
End If
'call Worksheet_Activate to update the lists
Worksheet_Activate

End Sub


pcor said:
I have data in Col A & B,\. The data starts at line one and CURRENTLY goes to
line 214..but that will increase over time.
In order to better display this data I would like a micro that would display
all the data in 5 blocks accros the screen.
So The first FIFTH of Cao A & B would remain where it is
The second FIFTH would be copied to COL D & E(leaving a col for seperation)
the third fifth would be copied to col G & H
and the same until all the data was listed in 5 BLOCKS(A & B D & E G & H
J & K M & N)
Any assistance would be appreciated
Thanks
 
G

Guest

Makes me happy to know it did the trick for you. Thanks for the feedback.

pcor said:
That works REALLY well. Thanks very much

JLatham said:
This code all goes into the worksheet's code module. To put it there,
right-click on the sheet's name tab and select [View Code] and then copy and
paste all of the code into it. If you end up with two "Option Explicit"
statements at the top, delete one of them.

To explain - there's one variable set up to determine if the 4 lists need to
be updated while using the sheet because you added/deleted row(s) in column
A. The _Deactivate event handler sets that variable to zero so that the
lists will be updated the next time you select the sheet after having
selected another sheet. The _Change() event handler determines if you've
added/deleted row(s) in column A.

The _Activate event actually does the work, so it'll always show current
information when you initially select that sheet.

The one thing that doesn't happen is that any changes made to existing data
in A or B won't be reflected in the 4 other groups until something causes an
update to those lists - simply choosing another sheet and returning to it
will refresh the lists.

Here's the code:

Option Explicit
Dim usedRowCount As Long

Private Sub Worksheet_Deactivate()
usedRowCount = 0
End Sub

Private Sub Worksheet_Activate()
Dim lastRow As Long
Dim sectionSize As Long
Dim startRow As Long
Dim endRow As Long
Dim sourceRange As Range
Dim destRange As Range

If Val(Left(Application.Version, 2)) < 12 Then
'in pre Excel 2007
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Else
'in Excel 2007 or later
lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
End If
If lastRow = usedRowCount Then
Exit Sub ' no new/deleted rows - but changes not updated
End If
Application.EnableEvents = False
usedRowCount = lastRow
sectionSize = Int(lastRow / 5) + 1
'clear out any previous results in extra columns
Range("D:E").ClearContents
Range("G:H").ClearContents
Range("J:K").ClearContents
Range("M:N").ClearContents
'pick a cutoff point: if fewer than 40 rows, don't do anything
If sectionSize < 40 Then
Exit Sub
End If
'begin at sectionSize+1 to 2*sectionSize
startRow = sectionSize + 1
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("D1:E" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("G1:H" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("J1:K" & sectionSize)
destRange.Value = sourceRange.Value

startRow = endRow
endRow = startRow + sectionSize
Set sourceRange = Range("A" & startRow & ":" & "B" & endRow)
Set destRange = Range("M1:N" & sectionSize)
destRange.Value = sourceRange.Value
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim currentLastRow As Long

If Target.Column > 2 Then
Exit Sub ' no change in columns A or B
End If
If Val(Left(Application.Version, 2)) < 12 Then
'in pre Excel 2007
currentLastRow = Range("A" & Rows.Count).End(xlUp).Row
Else
'in Excel 2007 or later
currentLastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
End If
If currentLastRow = usedRowCount Then
Exit Sub ' no new/deleted rows - but changes not updated
End If
'call Worksheet_Activate to update the lists
Worksheet_Activate

End Sub


pcor said:
I have data in Col A & B,\. The data starts at line one and CURRENTLY goes to
line 214..but that will increase over time.
In order to better display this data I would like a micro that would display
all the data in 5 blocks accros the screen.
So The first FIFTH of Cao A & B would remain where it is
The second FIFTH would be copied to COL D & E(leaving a col for seperation)
the third fifth would be copied to col G & H
and the same until all the data was listed in 5 BLOCKS(A & B D & E G & H
J & K M & N)
Any assistance would be appreciated
Thanks
 

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