1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Solved: Help on another macro

Discussion in 'Business Applications' started by djangojazz, Feb 12, 2007.

Thread Status:
Not open for further replies.
Advertisement
  1. djangojazz

    djangojazz Thread Starter

    Joined:
    Apr 11, 2006
    Messages:
    301
    Hello some people here helped me immensely on another macro and I was curious if I could tweak some code to do a few things. See the old thread to start if you wish

    Old thread

    Take a look at the before and after excel sheets.

    1. Time needs to remove a specific time. IE: although you can't see it it shows "02/05/2007 12:45 pm". During the macro transfer it would be nice to remove that and just show the date. There is an excel formule like =leftn(10), which will show the left characters I specify but does anyone know if you can plug a code like that directly in VBA?

    2. The time is not converting on the sum function anymore properly at times. The time to convert is now in what appears to be "hh:mm" that is left aligned but the sum function seems to ignore it at times. Any ideas on the code why?

    3. Now this is just a hope and might not be accessible for a VBA macro at all but can you set a macro to apply to all active sheets? Meaning when I hit my quick key could it just be smart enough to convert Waldo and Ken without having to click on each sheet to do them?

    Any help is much appreciated and the old code is attached but here it is as well. OH AND THE TRANSLATER PAGE IS TAKEN OUT, I REALIZE IN LINE 4 OR SO "Set wsOrig = Sheets("Translator") 'Change as needed/desired" can be changed to whatever I want, I just omitted it accidentally for my example but it would be fine to leave it in the code if needed. Thanks.

    Code:
    Option Explicit
    
    Sub ConvertTimeData()
        'Delcare variables
        Dim ws As Worksheet, wsOrig As Worksheet, i As Long
        'Set variables
        Set wsOrig = Sheets("Translator") 'Change as needed/desired
        'Set application properties for effeciency
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        'Add a new sheet for restructured data
        Set ws = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(1))
        'Set new sheet header (workers name)
        ws.Range("A1").Value = wsOrig.Range("B4").Value
        ws.Range("A2").Value = "Approved________________________________"
        ws.Range("A52").Value = "Supervisor approved________________________________"
        'Set data range formulas
        ws.Range("A4").Formula = "Date"
        ws.Range("B4").Formula = "Enter Job"
        ws.Range("C4").Formula = "Enter Phase"
        ws.Range("D4").Formula = "Enter Hours Worked"
        ws.Range("A5:A50").Formula = "=" & wsOrig.Name & "!A12"
        ws.Range("B5:B50").Formula = "=" & wsOrig.Name & "!E12"
        ws.Range("C5:C50").Formula = "=" & wsOrig.Name & "!F12"
        ws.Range("D5:D50").Formula = "=" & wsOrig.Name & "!G12"
        'Miles as well as the Fill in the blanks notice
        ws.Range("A53").Value = "Miles"
        ws.Range("A54", "B54").Value = "M_________"
        ws.Range("A55", "B55").Value = "T_________"
        ws.Range("A56", "B56").Value = "W_________"
        ws.Range("A57", "B57").Value = "Th________"
        ws.Range("A58", "B58").Value = "F_________"
        Range("A60:A63").Font.Size = 18
        ws.Range("A60").Value = "Please fill in the blanks and be aware that the"
        ws.Range("A61").Value = "timecard is written on Sunday, if you went on"
        ws.Range("A62").Value = "an emergency there is a possibility that"
        ws.Range("A63").Value = "all of your time may not be shown accurately."
        'Clear all zeros
        Call ClearAllZeros(ws.Range("A5:D50"))
        'Leave data as static values
        ws.Range("A4:D50").Value = ws.Range("A4:D50").Value
        'Set totalization labels
        ws.Range("C53").Value = "Total Hours"
        ws.Range("C54").Value = "Regular Hours"
        ws.Range("C55").Value = "Vacation Time"
        ws.Range("C56").Value = "Holiday Time"
        ws.Range("C57").Value = "Overtime"
        ws.Range("C58").Value = "Double Time"
        'Enter totalization formulas
        ws.Range("D53").Formula = "=SUM(D5:D50)"
        ws.Range("D55").Formula = "=SUMIF(C5:C50,""Vacation Time"",D5:D50)"
        ws.Range("D54").Formula = "=D53-SUM(D55:D58)"
        ws.Range("D56").Formula = "=SUMIF(C5:C50,""Holiday Time"",D5:D50)"
        ws.Range("D57").Formula = "=SUMIF(C5:C50,""Overtime"",D5:D50)"
        ws.Range("D58").Formula = "=SUMIF(C5:C50,""Double Time"",D5:D50)"
        'Set column widths
        ws.Range("B:D").EntireColumn.AutoFit
        'Set formats
        ws.Range("A:A").NumberFormat = "mm/dd/yyyy"
        ws.Range("B:C").NumberFormat = "General"
        ws.Range("D:D").NumberFormat = "[h].mm"
        'Set border formats
        ws.Range("A4:D4").BorderAround xlContinuous, xlThick, xlColorIndexAutomatic
        With ws.Range("A5:D50")
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThick
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeTop).Weight = xlThick
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideVertical).Weight = xlThin
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).Weight = xlThin
            .BorderAround xlContinuous, xlThick, xlColorIndexAutomatic
        End With
        'Delete all blank rows
        For i = 50 To 6 Step -1
        If WorksheetFunction.CountA(ws.Range(ws.Cells(i, 1), ws.Cells(i, 4))) = 0 Then
        ws.Rows(i).EntireRow.Delete
        End If
        Next i
        'reset application properties to natural state
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End Sub
    
    Sub ClearAllZeros(rngClear As Range)
        Dim c As Range
        For Each c In rngClear
            If c.Value = 0 Or c.Value = "" Then
                c.ClearContents
            End If
        Next c
    End Sub
    
     

    Attached Files:

  2. djangojazz

    djangojazz Thread Starter

    Joined:
    Apr 11, 2006
    Messages:
    301
  3. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    Loathe as I am to comment on code submitted by a codemeister ...

    ... for #1, after:

    'Leave data as static values
    ws.Range("A4:D50").Value = ws.Range("A4:D50").Value


    try:

    ws.Range("A4:A50").Replace What:=" *", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False


    #2, "The time is not converting on the sum function anymore properly at times." -- err, works for me. Which times?

    #3 is fairly out of my league, with the whole Option Explicit & 'Declare variables thing. However, try:

    For Each ws In ActiveWorkbook.Sheets
    Set wsOrig = ws 'Change as needed/desired


    after 'Set variables, and:

    Next ws

    before End Sub

    HTH
     
  4. OBP

    OBP

    Joined:
    Mar 8, 2005
    Messages:
    19,895
    Oh dear another Excel application struggling to imitate Access.:D
     
  5. djangojazz

    djangojazz Thread Starter

    Joined:
    Apr 11, 2006
    Messages:
    301
    Yeah the problem is that the second macro starting with the 2nd sub at the bottom then get's an error:

    "Microsoft Visual Basic" Window says:
    Run time error: '13':
    Type mismatch

    If I try to debug it goes to the line:

    Sub ClearAllZeros(rngClear As Range)
    Dim c As Range
    For Each c In rngClear
    If c.Value = 0 Or c.Value = "" Then
    c.ClearContents
    End If
    Next c
    End Sub

    If I try to debug further it has errors with clearing options. I was thinking of using an array as something like:

    Sheets(Array("whatever1", "whatever2", "whatever3", etc...)).Select

    But..... then I have to name my sheets every time. Honestly that code you gave was great but isn't there a function just meaning: "The active sheet that I am clicking in"? It would be great as I said to just get all the sheets to go at once but if not oh well. I just am getting tired of having to copy and paste sheet after sheet to do the function the macro is doing. If an array is the best method maybe I should go that route instead of all active sheets.

    In all honest that's because the real workbook has 40 sheets and gets a little tiring doing 40 one at a time, copying and pasting them to my translater sheet. I'm up for ideas but the code is working great, there just has to be one more function to get it to apply to a bunch of sheets at once, or at least let me click one to the next and just hit my quick key.

    Anyways Bomb thank you so much for your help thus far the code since it's beginning and the new release I had to tweak a little works fast and never crashes except for this one issue that finds an error and I have tried looking on Google for an hour or so but without knowing the exact funtion you want it's hard to search at times.
     
  6. Jimmy the Hand

    Jimmy the Hand

    Joined:
    Jul 28, 2006
    Messages:
    1,223
    I think the collection should be specified more explicitly.
    (For Each c In rngClear.Cells instead of For Each c In rngClear)
    Also, I see no point in checking c.Value against an empty string, because the result of ClearContents will be an empty string, anyway. So I would modify the sub like this:

    Code:
    Sub ClearAllZeros(rngClear As Range)
        Dim c As Range
        For Each c In rngClear.Cells
            If c.Value = 0 Then c.ClearContents
        Next c
    End Sub
     
  7. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    Here's my reply re: "isn't there a function just meaning: "The active sheet that I am clicking in"? It would be great ..."

    The attached is the alternative method I mentioned (IIRC) using a template sheet. Initially you'll see the Template sheet is all errors, so what the macro does is (a) plug in sheet names sequentially (b) "clone" the template sheet (c) hard-code the cloned sheet (convert the formulas to values).

    You can part-test the macro by entering a sheet name (Waldo or Ken) in Template!A1, to see what I mean. Then run the macro to create 2 summary sheets, "Waldo_x" & "Ken_x".

    Doing it this way means all the formatting is done up-front, i.e. outside of the macro. Of course I'm not saying one way's better than any other way, it's just an option.

    HTH.

    FTR, the actual macro is slimmed down considerably courtesy of the method, i.e.:

    Sub Templates()
    Application.ScreenUpdating = False
    For Each Sheet In ActiveWorkbook.Sheets
    If Sheet.Name <> "Template" Then
    Sheets("Template").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
    ActiveSheet.Name = Sheet.Name & "_x"
    Range("A1") = Sheet.Name
    Range("A4:D50").Value = Range("A4:D50").Value
    Range("A5:A50").SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
    End If
    Next Sheet
    Application.ScreenUpdating = True
    End Sub
     

    Attached Files:

  8. djangojazz

    djangojazz Thread Starter

    Joined:
    Apr 11, 2006
    Messages:
    301
    Wow, mixing templates with VBA code is above my head but that works SO much better. Thanks so much Bomb, it works faster, more secure, has less lines of code to process, and does exactly what I want. Any suggestions on learning some VBA more on my own? I am interested in more macros but I don't always want someone to do the code for me just at times I know stuff is over my head. I know about networks and physical things more than code but I'm not afraid of code just ignorant of a lot of properties and need to learn more about what does what.
     
  9. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    A frequent response to "how do I learn VBA?" is "try performing some basic actions while recording as a macro, then study the resultant code".

    The downside with the macro recorder is that it'll generate heaps of superfluous crap, but by studying it and experimenting you've a fair chance of figuring what you can strip out in the interests of efficiency. For example:

    Select A1:A3 -- copy -- select C3 -- paste.

    The recorded output for that would be:

    Range("A1:A3").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste


    but it can be stripped down to:

    Range("A1:A3").Copy Range("C1")

    HTH.
     
  10. Sponsor

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/543498

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice