No thoughts on this at all?
On Jul 2, 12:54 pm, Dustin <dustin.ho...@gmail.com> wrote:
> Hi Everyone!
>
> The following code works (not the best), but is inefficient, in my
> opinion. It takes a few minutes to run, which is unacceptable. I am
> looking for a re-think about how this can be done in order to make it
> run faster.
>
> The code looks at a table that is in order chronologically, but not
> consecutive. This portion of the code goes through and inserts rows
> and the appropriate index in that row.
>
> For instance:
>
> Before the code runs, the table looks like this:
>
> Column: S T ....
> ClientID Account
> 2401 a
> 2402 b
> 2410 c
> 2415 d
> .... ...
>
> After the code runs:
>
> Column: S T ....
> ClientID Account
> 2401 a
> 2402 b
> 2403
> 2404
> 2405
> 2406
> 2407
> 2408
> 2409
> 2410 c
> 2411
> 2412
> 2413
> 2414
> 2415 d
> .... ....
>
> THE CODE:
>
> Sub fillInRows()
>
> Application.ScreenUpdating = False
>
> Windows("ConvertColumns2.xlsm").Activate
> Sheets("Main").Select
> Range("D2").Select
> beginning = ActiveCell.Value
> Range("E2").Select
> ending = ActiveCell.Value
>
> Sheets("Output").Select
> Range("S2").Select
> Dim Count As Integer
> Count = beginning
> Dim rowCount As Integer
> rowCount = 1
> Dim offs As Integer
> offs = 1
> upperLimit = ending
>
> Total = Worksheets("Main").Range("E2").Value - Worksheets("Main").Range
> ("D2").Value
> current = 0
>
> 'Check to see if the first cell is the beginning of the range...
> If Range("S2") <> Worksheets("Main").Range("D2").Value Then
> Range("S2").Select
> Selection.EntireRow.Insert
> ActiveCell.FormulaR1C1 = Worksheets("Main").Range("D2").Value
> End If
>
> 'Check to see if the data is there...
> If Range("S2") = "" Then 'If the first cell is empty, kill program
> MsgBox "The first cell is empty... please enter raw data and re-
> run macro"
> End 'if it is the case that the first cell is empty, exit macro
> End If
>
> 'Since the data is there, insert rows where needed...
> If Range("S2") <> "" Then 'When the first cell is occupied, we are
> ready to begin.
> Do While (offs + 100) <= upperLimit
> If ActiveCell.Offset(1).Value = (Count + offs) Then 'If
> the next cell is one more than the previous cell, then..
> ActiveCell.Offset(1).Select 'go to the next cell in
> the column
> offs = offs + 1 'increase the offset from the top
>
> Else 'if the numbers are not in order...
> ActiveCell.Offset(1).Select
> Selection.EntireRow.Insert
> ActiveCell.FormulaR1C1 = Worksheets("Main").Range
> ("D2").Value + offs 'put the appropriate number in the new row
> offs = offs + 1 'increase the offset value by 1
> 'MsgBox offs 'print the offset number for verification
> End If
>
> current = current + 1
> numDone = current / Total
> With UserForm1
> .FrameProgress.Caption = Format(numDone, current & "/" &
> ending)
> .LabelProgress.Width = 200 / ending
> End With
> ' The DoEvents statement is responsible for the form updating
> DoEvents
>
> Loop
> End If
> Application.ScreenUpdating = True
> End Sub
--~--~---------~--~----~------------~-------~--~----~
----------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 5,000 subscribers worldwide and receive many nice notes about the
learning and support from the group. Our goal is to have 10,000 subscribers by
the end of 2009. Let friends and co-workers know they can subscribe to group at
http://groups.google.com/group/excel-macros/subscribe
-~----------~----~----~----~------~----~------~--~---
