You can just add a simple If...Then Statement at the end. I would also
recommend you change your variable declarations to Double and Longs. Not a
big deal, but I think
VB runs a micro second faster this way, because it has
to convert Singles and Integers, but I could be wrong. Heres your code.
Hope this helps! If so, let me know, click "YES" below.
Public Sub CopyRecordsfromDatatoDatabase()
Dim myArray(7)
Dim numRows As Double
Dim myColumn As Long
Dim myRow As Double
Dim i As Long
Dim LoopCounter As Long
myRow = 2
i = 1
LoopCounter = 0
Worksheets("data").Activate
numRows = Selection.CurrentRegion.Rows.Count
Do
For myColumn = 6 To 26
Worksheets("data").Activate
With ActiveSheet
myArray(1) = .Cells(myRow, 5)
myArray(2) = .Cells(myRow, 3)
myArray(3) = .Cells(myRow, 2)
myArray(4) = .Cells(1, myColumn)
myArray(5) = .Cells(myRow, myColumn)
myArray(6) = .Cells(myRow + 1, myColumn)
myArray(7) = .Cells(myRow + 2, myColumn)
.Cells(myRow, myColumn).Clear
.Cells(myRow + 1, myColumn).Clear
.Cells(myRow + 2, myColumn).Clear
End With
Worksheets("Database").Activate
With ActiveSheet
i = i + 1
.Range(.Cells(i, 1), .Cells(i, 7)) = myArray
End With
Next myColumn
Worksheets("data").Activate
With ActiveSheet
.Cells(myRow, 5).Clear
.Cells(myRow, 3).Clear
.Cells(myRow, 2).Clear
End With
myRow = myRow + 3
LoopCounter = LoopCounter + 1
If Int(LoopCounter / 12) = LoopCounter / 12 Then
ActiveWindow.SmallScroll Down:=36
End If
Loop Until Cells(myRow, 1).Row numRows
End Sub
--
Cheers,
Ryan
"Slim Slender" wrote:
This works perfectly! I would like it to do just one more thing,
though.
In the second to last line of code, instead of scrolling three lines
after it processes three lines, I would like it to wait until the loop
has run twelve times and then scroll 36 lines, or a screen, to follow
the action. I've added the LoopCounter variable, I believe that I just
need some kind of For ... Next or Do Until around the line
"ActiveWindow.SmallScroll Down:=3".
Public Sub CopyRecordsfromDatatoDatabase()
Dim myArray(7)
Dim numRows As Single
Dim myColumn As Integer, myRow As Single
Dim i As Integer
Dim LoopCounter As Single
myRow = 2
i = 1
LoopCounter = 0
Worksheets("data").Activate
numRows = Selection.CurrentRegion.Rows.Count
Do
For myColumn = 6 To 26
Worksheets("data").Activate
With ActiveSheet
myArray(1) = .Cells(myRow, 5)
myArray(2) = .Cells(myRow, 3)
myArray(3) = .Cells(myRow, 2)
myArray(4) = .Cells(1, myColumn)
myArray(5) = .Cells(myRow, myColumn)
myArray(6) = .Cells(myRow + 1, myColumn)
myArray(7) = .Cells(myRow + 2, myColumn)
.Cells(myRow, myColumn).Clear
.Cells(myRow + 1, myColumn).Clear
.Cells(myRow + 2, myColumn).Clear
End With
Worksheets("Database").Activate
With ActiveSheet
i = i + 1
.Range(.Cells(i, 1), .Cells(i, 7)) = myArray
End With
Next myColumn
Worksheets("data").Activate
With ActiveSheet
.Cells(myRow, 5).Clear
.Cells(myRow, 3).Clear
.Cells(myRow, 2).Clear
End With
myRow = myRow + 3
LoopCounter = LoopCounter + 1
ActiveWindow.SmallScroll Down:=3
Loop Until Cells(myRow, 1).Row numRows
End Sub
.