VBA code to format Excel sheet

Sub Downtime_Formatting()
'
' Downtime_Formatting Macro
' Macro recorded 6/8/2004 by BEbert
'

'
    ActiveCell.FormulaR1C1 = "Date"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Shift"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Clock"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "TotHrs"
    Rows("1:1").Select
    With Selection.Font
        .Name = "MS Sans Serif"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    ActiveWindow.SmallScroll Down:=37
    Rows("60:60").Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Range("E60").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-58]C:R[-1]C)"
    Range("E60").Select
    Selection.Copy
    Range("E60:J60").Select
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.Font.Bold = True
    ActiveWindow.SmallScroll Down:=45
    Rows("106:106").Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Range("E106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-44]C:R[-1]C)"
    Range("E106").Select
    Selection.Copy
    Range("E106:J106").Select
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.Font.Bold = True
    ActiveWindow.LargeScroll Down:=1
    Range("E144").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-36]C:R[-1]C)"
    Range("E144").Select
    Selection.Copy
    Range("E144:J144").Select
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.Font.Bold = True
    Range("K128").Select
   
End Sub

**This is a copy of the simple Macro I made that 'DOES NOT' work, since it cannot handle the situation of shifts 1,2, &3 ending on different rows.

HELP!

I will up the points considerably with a working solution.

Thanks again.

given a start range,
say B1
1 is assumed to be a header
also assume each cell has a value therefore first blank cell is end of data

dim iRow = 2

while range("B" & irow).Value <> ""
    iRow = iRow + 1
wend

'after this we know the last row



to add a formula
Range("B" & iRow).Value = "=SUM(B2:B" & irow-1)

to add row totals for other columns, just change the column letter




'an alternative way to get last row is this
iLastRow = Range("A65536").End(xlUp).Row

EmmaTech,
How do you know when the shifts start/end? Does Column B actually have the word "shift" in it, at the beginning of the shifts? If so, this could be very easy. I'll start working on one that works like that, but I can easily change it depending on how you have it setup.
Thanks
Matt

Hi Emma,
When you import your data, Is there always a space between the shifts, if so, how many lines are between each shift, 1 or more than 1, or does it vary each time.  
MD

Sorry, I could not figure out how to insert this code in my sample macro above.  Running alone I did not get the results needed in the original question.

I appreciate your help, but could you show me how to integrate this into my posted code (or should I toss it all) and give a complete answer with comments?  I am receiving errors and cannot see where this code with insert the requested 2 lines after each shift & total columns at each shift interval.

Please ask if I can do more to clarify.

Depending upon your imported layout will affect the code slightly.  If you can answer my query above, I should be able to give you some code to adjust your splits as required.  I can tidy things up a bit as well, but reuse your code where possible, as you understand it.  

mvidas - Shift is the column name for 'B'.  The Excel sheet shows all '1's in that column, then '2's, then '3's.  So, shift 2 info begins when the number in column B changes to 2, then 3.

Columns:
Name - Shift - Clock#- Total Hours - 232 - 234 - 245 - 345 - 238  (numbers are cost centers)
         
* After shift '1' ends I need the macro to insert a line to total "total hrs, and all cost center columns" with bolding, then insert an additional blank line for good looks.  After shift '2' info ends, do the same thing.  UNFORTUNATELY, THIS LOCATION WILL CHANGE WITH EACH DAY ON THE SHEET SO THE MACRO NEEDS TO SEARCH FOR THE LAST '1' IN COLUMN 'B' BEFORE TOTALLING AND SUCH, THEN DO THE SAME FOR SHIFT '2' AND '3'.

Does this make sense????

just put it in the end of your code, should be ok

couldnt this lot be put in as one command

Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit


EmmaTech, here is an idea

record a macro when in Excel,
say select some columns and select menu option to autofit
then save it, it will save as a macro

then look at the code

there you are, how to find code to do things

Yes.  That helps.
Back in touch soon.
BTW, mvidas is the other guy!

mdmack -  It is an export from Access.  NO, there is no space in the excel sheet between shifts.

I originally tried to get this question answered in a way that would have Access transfer the spreadsheet, then open it and perform this, but no luck from the Access group.  So, here I am trying to do it with a Macro.  Hopefully anything I learn will transfer to Access module one day.

Thanks!

Sorry about the confusion.  mdmack - the time on these posts all hit so close I am confused. haha  :)

Thank goodness I have someting to study.  (hehe)

Other guy (mvidas) - Just kidding.  I appreciate your efforts too much to call you the 'other guy'.

I ended up adding your code to a separate module and it basically made my (recorded macro) look really bad.  Did you code this directly with VBA?  Nice.

** ONE problem.  It gives two blank lines and totals shift 1 nicely, but then adds that number to the total of shift 2, and 3.  In other words, shift 1 totals are correct, but shift 2 and 3 are bringing in the previous totals rather than standing alone.  Can you fix this????

---- continued thanks.   After this one problem is solved I see no other issues, per a test run.

One last thing!!  sorry.....

I would like a solid lines between cells.  Border?

:)

Hmm, I wonder how I missed that!

Change:
   Tr = cLL.Row + 1
to:
   Tr = cLL.Row + 3

I took your code (the top at least), abbreviated it, and just coded the rest.  I wouldn't have been able to do this 3 months ago, but thanks to EE I can now!
<I've never been 'the other guy', so I figured I'd take the chance to be him while I could :P>
Matt

I should have refreshed..

Do you want the border:
Between every cell? Around shifts? Above the subtotals?

Hi Matt,
I hadn't seen your post when I responded.  As you seem well on the way, I'll leave you to it.
MD

Its no problem, MD, I figured you were working on a variation yourself! Never hurts to have more than one way to do something (your way/fast way, my way/slow way).  I just have a bit more time than usual today as I'm spending the whole day printing (a billing system of our company prints a page about every 1:06 minutes due to its programming-bad!), and IE and excel are two of the few programs that work normally while I print, so I'm just reading old lounge posts, old riddles, etc, and just happen to check excel when she posted the link

OK Matt.
BTW I posted a query in Word.  Any ideas?
MD

Ok, I noticed something else.  Don't become sick of me.

The totals are rounding to 'tenths'.  On my old macro you get '14.78', but your new code gives '15'.  Not consistant.......also '8.68' in macro, gave '8.7' in your code??  So why didn't '14.78' give '14.8'?  hmmm

Anyway, I just need the 14.78 without rounding, since this is hours we are talking about.

On the borders..........it is really a 'grid'.......so horizontal and vertical around all cells.  This I could figure out from a macro, but your stuff looks cleaner and may help me learn the right way.

ONE more thing I noticed on last run of current code.  The autofit for columns did not seem consistant.

Oh, this is because I autofit my columns before I did totals I bet.  Is this right?

ok.......the rounding seems fine on review.  Actually my macro did the rounding on this last test.  Not sure what is happening.

??

Sorry about the delay, I was working on MD's question in word.  You did the autofit before subtotals, exactly.  I am doing them afterwards, in case the subtotals produces an extra digit.  You say the rounding seems fine on review, but you could change the part that creates the subtotals to:

   With Range(Cells(cLL.Row + 1, 5), Cells(cLL.Row + 1, 10))
    .FormulaR1C1 = "=SUM(R[-" & Lr - Tr + 1 & "]C:R[-1]C)"
    .Font.Bold = True
    .NumberFormat = "#,##0.00"
   End With

All I did was add the .numberformat part in there.  But now I see it on MD's Lining code anyways, so you wouldn't even have to add it here.
Not sure why I'm posting this then!

Sorry Emma,
Didn't mean to "poach."

Not sure of how Emma feels, but adding to questions I'm helping out in is always allowed in my book, as I don't care about points! If you can post the help faster, it helps her out faster!

Hey, it's all good!!

One thing, I did not totally understand how to mix "md" border code with "mvida" original code.

ET

Just put the word

 Lining

or even

 Call Lining

Right before the  End Sub  line in my macro to call his (assuming they're in the same workbook)

Or better yet (save code space), put the following code above the line that says  Columns("A:J").Autofit

 With Intersect(Columns("A:J"), ActiveSheet.UsedRange).Borders
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
 End With
 Intersect(Columns("E:J"), ActiveSheet.UsedRange).NumberFormat = "#,##0.00_ ;-#,##0.00 "

Takes care of it all!
Matt

Hi Emma,
Its often easier to write small sections of code to do one task.  You can then call this code from within another macro.  for example

Sub SortItAll()
    'Do the sums
    DownTime_Formatting
    'Add the lines
    Lining
End Sub

This also means that a useful piece of code can be used many times, without rewriting it into a larger macro.  You can make this more flexible by passing values to your "useful" code. eg

Sub SortItAll()
    'Add some lines
    Lining "A:C"

    'Add more lines
    Lining "G:J"
End Sub


Sub Lining(MyRange)
    Dim Ra As Range
    Set Ra = Application.Intersect(Columns(MyRange), ActiveSheet.UsedRange)
    Ra.Select
'etc
End Sub


   

This is unrelated to the question at hand..

When did the 'feedback' option happen?  At the top, I see:

Question Title: VBA code to format Excel sheet
Author: EmmaTech  feedback
Points: 500
Date: 06/10/2004 09:53AM EDT

I can click on feedback to get to
https://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/memberFeedback.jsp?mid=2322191&qid=21020882
with a yellow 'hint bar' (my phrase, not sure what its really called) that says "Provide feedback on this Member pertaining to this Question"
It's like this on all questions now, but I would swear that I didnt see it an hour ago..

Just noticed it.  Never seen it.  Weird.

Never seen it before.  I wonder if we get to give feedback to those who ask the questions!

No way.  EE won't take a chance on offending paying customers!  (hehe)  I hope!

Yeah, look at the Member screen ( https://www.experts-exchange.com/M_1324117.html ), theres the feedback at the bottom

its even on the expert's part of completed questions!

We do get to feedback on the questioner.  Check out Emma!

Kinda cool, will definately take getting used to!

Emma,
We lost track of the question thanks to our short attention spans! I'm all for chatting about the feedback thing, but is this macro doing what you want it to now?  I just want to make sure you get your answer, first and foremost..

Crawler!

Dangit.....you distracted me!!   (hehe)

Let me try and build the Macro with ALL the code sections and run.  Back in 30 minutes, or 20 hours.

ET

Looks like 20 hours :(

17.....best I could do.  Combining code now.

Wow.

Hi EmmaTech, had to leave yesterday, had to catch my train
check this morning, just overloaded with emails from this post!

its certainly been busy

I take it your in safe hands now or do you still need help

how far have u got

"mdmack" and "mvidas".........thank you.  I'm going to split heavy to mvidas, because that is the code I used and it works perfectly.  Good assist point for 'md' for the extra effort and training.  

Which area may I post the additional points (for both of you) for the added on sections of my question?

ET

Been a pleasure.  No additional points required.
MD

It looks like I'm about an hour too late to say "split it 50/50", but I do agree no additional points needed.  Glad it's working, been fun!
Matt

Hi Emma (and Matt)
I decided that this function was useful to me in the office, and developed it as a more generic function.  It contains all sorts of calls, arrays stings etc. so If you can follow these Emma, you'll be able to use them in your code in the future.
Regards
MD
 

Option Explicit
Option Base 1
Sub DoSums()
    Dim Categories As Variant, Cats As String, Data As String
    Dim StartCell As String
    Dim SList As Range
    Dim CatCol As Integer, Lft As Integer, Rt As Integer, Wide As Integer
    Dim OSet As Integer, i As Integer, j As Integer
   
                                            'Get Category and Data columns
    Cats = InputBox("Enter column containing sorted categories")
    Data = InputBox("Enter columns containing Data" & vbCr & vbCr & "Enter as:   C:G")

    StartCell = Cats & "1"                  'First cell of Category column
    Range(StartCell).Select
    Categories = GetCats()                   'Create list of categories
   
    CatCol = Columns(Cats).Column           'Get Category column number
    Lft = Columns(Left(Data, 1)).Column     'Get left column of Data
    Rt = Columns(Right(Data, 1)).Column     'Get Right column of Data
    Wide = Rt - Lft                         'Width of data
    OSet = Lft - CatCol                     'Offset from Categories to Data
   
    For i = 2 To UBound(Categories)         'Split rows at changes; insert totals formula
        Range(StartCell).Select
        ActiveCell.Columns("A:A").EntireColumn.Select
        Selection.Find(What:=Categories(i), After:=ActiveCell).Activate
        ActiveCell.Rows("1:2").EntireRow.Select
        Selection.Insert Shift:=xlDown
        ActiveCell.Offset(0, Lft - 1).Range("A1").Select
        For j = 0 To Wide
            ActiveCell.Offset(0, j).FormulaR1C1 = SumRange
        Next
    Next
    'LastShift                              'Add totals below last data
    ActiveCell.Offset(2, -OSet).End(xlDown).Select
    ActiveCell.Offset(1, OSet).Select
    For j = 0 To Wide
        ActiveCell.Offset(0, j).FormulaR1C1 = SumRange
    Next
    Range("A1").Select
End Sub

Function SumRange()                         'Create string for SumRange
    Dim Bot As Integer, Top As Integer
    Bot = ActiveCell.Row() - 1
    Top = ActiveCell.Offset(-1, 0).End(xlUp).Row()
    SumRange = "=SUM(R" & Top & "C:R" & Bot & "C)"
    Debug.Print SumRange
End Function

Function GetCats() As Variant               'Create array containing Category data
    Dim Cats(), i As Integer, Up, Dn
    i = 1
    ReDim Cats(i)
    Cats(i) = ActiveCell.Value
    Do
        Up = ActiveCell.Value
        Dn = ActiveCell.Offset(1, 0).Value
        If Up <> Dn Then
            i = i + 1
            ReDim Preserve Cats(i)          'Increase size of array for next item
            Cats(i) = Dn
            Debug.Print Cats(i)
        End If
        ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell.Value = ""
    ReDim Preserve Cats(i - 1)              'Trim array to remove last(empty) item
    GetCats = Cats
End Function

Dang!  I got a ton of points to give.....(hehe)......no good to me.

'mdmack' ...thanks for the additional code.  NO, I have no idea what it means without a comment on EVERY line, but that's ok.  I will save it and one day maybe I will be able to add the comments myself.

One more question:   Can either of you guys recommend a good book?  I got a "Programming Excel book on the way from Amazon" but I am not against owning 2, or 3.  Was planning to learn Access, but decided to learn more about Excel until this project really NEEDS more Access developement.  Right now it mostly just needs analysis on the sheets I am exporting to Excel.

Thanks a million!

'md' and 'matt' .........

go here:

https://www.experts-exchange.com/questions/21022599/Good-book-to-learn-VBA-skills-to-program-Excel.html

To be honest Emma, I only ever bought one VB book, second hand, VB 6.0.  and while its OK, the language is not the same as Word, Excel or Access.  I've learned more here answering questions for others, than from any other source.  Don't be afraid to jump in with a solution if you have anything to offer, I'm sure Matt started in the same way as well.  
However, you may find this useful. especially for Access.  VB Essentials:  http://briefcase.yahoo.com/mdmackillop
MD

In Samples folder.

Hey MD and ET,

I've been out of town (out of the country, actually) the past couple days.  I've been told that the books at www.j-walk.com are great, I've never seen one (though the code on that site is great).

I took a few programming classes in college about 7 years ago, actually I majored in computer science, but decided then that programming was not what I wanted to do.  I grew up programming in AppleSoft basic on my old apple IIe, and that was really the extent of what I had done prior to that (aside from writing batch files and programming my graphing calculator for calculus and physics, hardly real programming).  

About 2 1/2 years ago I transferred from a call center job to a demanding and time-sensitive job that used Excel a lot, which I had little experience with (aside from things like =A1+A2).  To further myself in Excel I read quite a few websites, which is when I found EE.  I actually used the excel-vba site more than anything (http://www.excel-vba.com/av-contents.htm) until I had a firm grasp on excel itself.  I then used google to search through the EE PAQ when I would get stuck on something, and it was only natural that I shifted from excel formulas to vba to accomplish what I needed (I love efficiency, and love cutting down my workload even more).  I could mostly edit the macros that the recorder made to do what I needed, but could never write my own.  

About 6 months ago I transferred to another job, one that involved a lot of manual work and data entry.  Because I do not like tedious work (need to be challenged), I decided to focus on vba to do this.  Editing recorded macros and changing bits of code I found on EE allowed me to reduce my monthly workload from almost a full month to 40-50 hours.  This extra time allowed me to help out other people, but more importantly gave me time to sharpen my vba skills.  Once I had an idea of what was actually happening in the code I used (couple months time), I decided to start answering questions here.  Like MD said, I learned a LOT more once I started answering questions for other people (though my first attempts were not the greatest), as I'd try and figure out what to do as I was doing it.  Within 2 months of answering questions I became a 'guru' on EE, due to the amount of time I would spend on EE (my boss allowed me to so I could become more skilled).  Because of EE, the original workload of a month's time is now about 20 hours for me.  I just keep getting new things added to my workload, as I now have the time and it gives me a change, more or less.  When I have a question about specific things within Excel, I ask a question about them, even though they have little to do with a specific project.  I just love the fact that EE has such knowledgable people answering questions that it's like having multiple programming teachers available on call anytime.  

So to make this long story short, I think EE is the best book you could ever get.  Always updated, interactive, and I can honestly say that aside from the Lounge I've never seen a reply of "Thats a stupid question".  And the best part is, after you've answered a few questions, it's an endless resource that doesn't cost anything (aside from the time you spent learning).  'Free' knowledge, smart peers, how could you go wrong?

My two cents, at least.  Thanks for the feedback ET, by the way!  I'm not sure yet how I feel about the whole feedback thing, but if I decide if I'm going to start leaving feedback for people, you'll surely get a positive vote.

MD, your feedback of ET reminds me of a fortune cookie I got recently :)

MV