Posts by Webbers

Mumps,

That is perfect!!! Thanks so much. I really appreciate this!

Hi all! I am having some issues adding a new requirement to my existing VBA code. This code works fine as is (although it is a bit slow to run), please forgive me as I am still learning. My new requirement is to add error handling that will advise the user if the file name already exists AND offer the user the option to overwrite the file (or not). I am having issues adding this on my own, as all the examples I have seen have te path and file name hard coded into the VBA code. But my file is a template that auto-generates a filename based on 3 cell variables.

Sub Save_WeeklyFile()


Dim fName As String         ' Output File Name
Dim Path1 As String         ' Path name (current directory)
Dim xlD As Workbook         ' Output file
Dim xlS As Workbook         ' THIS workbook
Dim shS As Worksheet        ' Worksheets in current workbook
Dim mySheetNames() As Variant


' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False


' Format to Generate Dynamic Name based on variables on sheet (Data)
    ' Sheet Name where every variables located:  data
        ' File Name:  C3
        ' Week #:  J3
        ' Period Ending:  R3


        Path1 = ThisWorkbook.Path
        fName = Sheets("Main").Range("C3").Value & " - Week #" & Range("J3").Value & " - Period Ending " & Format(Range("R3").Value, "mm-dd-yy") & ".xlsx"
        Set xlS = ThisWorkbook
 
' Create the new workbook
    Set xlD = Workbooks.Add


' Copy sheets in
    For Each shS In xlS.Sheets
        If shS.Name <> "Main" Then
            shS.Copy after:=xlD.Sheets(Sheets.Count)
            xlD.Sheets(Sheets.Count).Name = shS.Name
        End If
    Next shS


' Remove the superfluous sheets
    xlD.Sheets(1).Delete ' <!-- Removes sheet1 (Main)
   
' Hide the code sheet
    xlD.Sheets("codes").Visible = xlHidden
   
' Hide the code sheet
    xlD.Sheets("Improvements").Visible = xlHidden
    
' Save the workbook
    xlD.SaveAs Filename:=Path1 & "\" & fName, FileFormat:=51


'Close the workbook
    xlD.save


ResetSettings:
' Reset Macro Optimization Settings
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   xlS.Close True ' <!--- ' THIS workbook


End Sub

KjBox,

Works great! Sorry for the delay in responding, I was travelling for business.

KjBox,

Sorry, my bad... the format is mm.dd.yy

03 = month
04= day
19 = year

I need to extract a date from a text string. The string is a file name that will reside in a cell (and will be changed frequently. The date in blue is what I need extracted, only the date. I have extracted text strings before, however since I need to get it from the end (just before the file extension), AND the file is named with periods (instead of dashes) with the date... I am lost! Help! Thanks in advance!!!!

IIC WEEKLY - FRINGE BENEFITS RATES FOR PW PURPOSE AS OF 03.04.19.xlsx

Final desired format: 03-04-19

Carim,

PERFECT! I had tried a few things, but my syntax was off, so the script ran, message box appeared, b ut when OK was clicked, scripted continued. Thanks to your revision, it is exactly what I needed. Thank you so very much!

Carim,

I hope you can help. There has been a revised request for this highlighting macro. The code below is what you last provided me with. What I need is that these macros are executed ONLY when the user does something MANUAL to the workbook. If the user runs a macro to import or copy data to sheets within the workbook, nothing should be highlighted. However if the user manually adds a new row, to the workbook, that row (columns A-DD) will be highlighted in orange (color index 46). I did UAT with the user today and was advised that the user will select a row that is similar and copy/paste tht row to the 1st blank row, that the user will manually change any specifics. In this instance, the entire row (A-DD) should be orange, and then as each cell is changed by the user, only those cells would be pink.
The User copies an employee record, pastes to a new row. Then changes the employee name, emp #, start date, title, etc... only those changed cells are pink, the rest remain orange. Is this possible?

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub
Dim i As Double
i = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
If Target.Row > i Then
   Range(Cells(Target.Row, 1), Cells(Target.Row, 108)).Interior.ColorIndex = 46
ElseIf Target.Row <= i Then
   Target.Interior.ColorIndex = 38  ' <--- Color is pink (for individual changes)
End If
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' Mouse Right Click to Clear Colors
If Target.Row = 1 Then Exit Sub
Dim i As Double
i = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
If Target.Row > i Then
   Range(Cells(Target.Row, 1), Cells(Target.Row, 108)).Interior.ColorIndex = xlNone
ElseIf Target.Row <= i Then
   Target.Interior.ColorIndex = xlNone
End If
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Cancel = False
End Sub

Sorry about that Alan. All fixed.

I have a functional code, however it now requires one more criteria. I need to check at the beginning of this code to determine if cell I1 (on "Main", codename sheet2) is populated. This cell contains a date that is used in the renaming of the sheet tabs s well as the actual workbook. If I1 is blank, I need the macro to display a message box stating "Please enter the Payroll Date into cellI1", and the code should be exited. Now if cell I1 contains a date, then the macro should run.

Sub Save_Seperate_Sheets()


' Saves multiple sheets in another workbook based on the cell values
Dim fName As String         ' Output File Name
Dim Path1 As String         ' Path name (current directory)
Dim xlD As Workbook         ' Output file
Dim xlS As Workbook         ' THIS workbook
Dim shS As Worksheet        ' Worksheets in current workbook


' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual


Path1 = ThisWorkbook.Path
fName = Sheets("Main").Range("$C$4") & " " & Format(Sheets("Main").Range("$I$1"), "mm.dd.yy") & ".xlsx"
Set xlS = ThisWorkbook


' Rename sheets
    Call RenameSheets
    
' Create the new workbook
    Set xlD = Workbooks.Add


' Copy sheets in
    For Each shS In xlS.Sheets
        If shS.Name <> "Main" Then
            shS.Copy after:=xlD.Sheets(Sheets.Count)
            xlD.Sheets(Sheets.Count).Name = shS.Name
        End If
    Next shS


' Remove the superfluous sheets
    xlD.Sheets(1).Delete ' <!-- Removes sheet1 (Main)


' Hide the code sheet
    xlD.Sheets("codes").Visible = xlHidden
     
' Save the workbook
    xlD.SaveAs FileName:=Path1 & "\" & fName, FileFormat:=51


' Rename Sheet3 & Sheet4 back to default
' Call the RenameSheetsReset macro
    Call RenameSheetsReset


'Close the workbook
    xlD.save


ResetSettings:
' Reset Macro Optimization Settings
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   xlS.Close True ' <!--- ' THIS workbook


End Sub

Carim,
Thanks so much! Some things require approval from our corp hq in another country... and it is just plain stupid to be honest! But I need the paycheck. And yes I shall return. Thanks again for all your help!

~~ Sherry

Thanks Carim, for all your help. It is greatly appreciated. And I agree... I could not believe it either when I attempted to make some simple changes (or so I thought), and was shut down.

I need to keep things in basically the same format, as this template will be use by multiple other users. My company has strict protocols on things.... even silly things. In order to convert the database to a table, I need to get permission from "the powers that be". I am a lowly contractor, so I need to "color between the lines" for now.

- Why do I copy from row 2 down for formulas? Honestly because I do not know how to code it to copy from the last row containing formulas down., That would be the best way. But since I am still new, and the amount of data varies on a regular basis, I simply had no clue. I would prefer to past the formulas from the last row of existing row of formulas. I agree, starting from the final row of formulas would be better performance, it comes down to lack of knowledge on my part.
- Appending new records, I honestly do not know, this is not a process I am fully familiar with. I is a VERY detailed payroll process for government contracts. There are many variables, and sometimes, a formula calculation requires being overwritten in the form of a value or a revised formula. I have looked at the previous workbooks, and there are an abundance of highlighted cells and rows that had been colored manually for this purpose. It is an ongoing thing that happens constantly (and the users always select the ENTIRE row, not just the 103 actual columns within the range).

My role is to streamline and automate the process. The end user wastes so much time formatting, inserting columns and copying and pasting formulas from the previous workbook, and the list goes on!. Highlighting changed cells and rows

Carim,

It works perfect. I adjusted the script for the

Target.Row, 30

which you has for my sample file to 108 columns for my actual file. It still worked perfectly. But then I realized the when people are added, I have a script that copies the formulas to all rows with data. And this works perfectly... except now that I have your awesome highlighting script, the formatting is overwritten because my "formula" script uses that "Autofill" for this. Is there a better way that this script could copy the formulas (1st row of data is always row 2, headers in row 1), and copy all the way down? I love your script and it is exactly what I need. As is this script for the formulas... I just need a way to have my UpdateFormulas script NOT overwrite the formats that your highlighting created. As I may have mentioned this template is for another department, so things like this need tt be in place. Below is my code to update all formulas when data has been added. Please forgive the crude coding, as I am still new.

Sub UpdateFormulas()


' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual


' Sheet name & colum location to be deleted
    Sheet3.Select
    
'Range of Cells where Formulas are
' Column to designate formula must exist
    Range("I2").AutoFill Destination:=Range("I2:I" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("AC2").AutoFill Destination:=Range("AC2:AC" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("AJ2").AutoFill Destination:=Range("AJ2:AJ" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("AL2").AutoFill Destination:=Range("AL2:AL" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("AT2").AutoFill Destination:=Range("AT2:AT" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("BH2:CH2").AutoFill Destination:=Range("BH2:CH" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("CJ2:DD2").AutoFill Destination:=Range("CJ2:DD" & Cells(Rows.Count, "B").End(xlUp).Row)
    
' Sheet name & colum location to be deleted
    Sheet4.Select
    
'Range of Cells where Formulas are
' Column to designate formula must exist
    Range("I2").AutoFill Destination:=Range("I2:I" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("AC2").AutoFill Destination:=Range("AC2:AC" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("AJ2").AutoFill Destination:=Range("AJ2:AJ" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("AL2").AutoFill Destination:=Range("AL2:AL" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("AT2").AutoFill Destination:=Range("AT2:AT" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("BH2:CH2").AutoFill Destination:=Range("BH2:CH" & Cells(Rows.Count, "B").End(xlUp).Row)
    Range("CJ2:DE2").AutoFill Destination:=Range("CJ2:DE" & Cells(Rows.Count, "B").End(xlUp).Row)


' activates sheet of specific name
' Activates the "Main" tab (Sheet2)
    Sheet2.Activate


ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

NOTE: I was just doing some additional testing on the "add" highlighting code, and I noticed something that I don't know if you can add. If we add John smith, all his data, and the formulas, the row will be orange... but if one cell has to be overwritten, it should still change to pink (that one cell), despite the row being orange. The individual cell overwrites are primarily happening when there is a formula in the cell and it is replaced by a value or another formula. We need to be able to visually see these, hence the pink color. I should have specified this. Obviously you cannot know what I am thinking, sorry about that.

Carim----

I created a partial file... not with all the columns. I think I got to column AD. The names, addresses, employee name, pay rates... it is all bogus data, but represents the type of date that will be populated. The majority of data types that will appear on this worksheet are number values and dollar amounts, and about 75% of the worksheet is formulas. Now this worksheet is called Sheet3 (although not in the example), and the codename is also Sheet3. I would like to be able to use the codename rather than the name of the sheet, as I cannot control if the user decides to rename the sheet.

Hello all!

Okay, I have a template for another department I am developing. I need to add some conditional formatting via VBA. I managed to find a code on the forums and modified it. It meets one of my two requirements as is, but there is 1 change I would like (the range). I just either need a second code or modification to this code. I am still very new to Worksheet_Change coding. The code I found as works for "part 2 is below"

Part 1 - Any NEW entry will require the entire row to be highlighted (I recommend in either orange or yellow... no preference).
- The range of the data is columns A - DD
- The number of rows will vary from week to week as this is a global workbook (so I would rather not be required to list a specific range)
- The key cell that would indicate an entry is in column C, this is where the employee ID is located.
- For example, right now I have 1377 rows of data
- If I add something to cell A1378 or B1378, my "Part 2" VBA would kick in and highlight the cell (color #38) pink or whatever it is. If data was entered into cell C1378, then the entire row (A1378:DD1378) would be highlighted in yellow (or orange).
- I want the "add" script to run initially
- Many of these cells are formulas within the other columns, it is likely that another cell within the range of AA:DD although the row was added may require the user to overwrite it.
- In this instance, the row would be yellow (or orange) to indicate it was an added row, but then it may also contain some lpink cells to indicate cells overwritten

Part2 - Individual cells are chnged to pink (color #38) when changed.
- In the second line of the code, I would love it if the range is not limited
- This process is growing substantially
- The bi-weekly payroll has in excell of 25,000 rows
- The range can be based on whether the row has a value in column C
- Column C is the employee ID, which is the driving force behind all transactions

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A2:DD2500"


On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
.Interior.ColorIndex = 38
End With
End If


ws_exit:
Application.EnableEvents = True
End Sub

Worked like a charm, thanks so much!

Hello all!

I am stumped, I am a loss on how to make this calculation. The problem is my criteria is more complex for this calculation. There are a total of 5 criteria, one of which is a date, and then another that will need to use OR (at least I think). My more traditional formula is at the bottom, however it simply will not meet these needs. And with my Googling and research, I am stumped as to whether I should be using SUMPRODUCT, COUNTIFS or something else.
Now I need something that will will accommodate the following

[TABLE="border: 1, cellpadding: 1, width: 500"]

Criteria #1

C2:C1000

Process 1

Criteria #2

A2:A1000

Manager

Criteria #3

E2:E1000

On or Before 3/1/2019

Criteria #4

K2:K1000

Completed

OR

Criteria #5

K2:K1000

In Progress

[/TABLE]

=SUMPRODUCT(--(C2:C10="Process 1"), --(A2:A10="Manager"))

KjBox,

Sorry for the delay, I have been out of town. As I stated, I made a duplicate of my original file. Trimmed the quantity and converted the sensitive data, otherwise it is identical. I do not see how the end result would be any different base on what I did.

Yes, nd when I use it on the "sample" file I provided, it works perfectly. However when I use it on my real file, which contains additional tabs and more projects than just the 8 indicated in the example, it does not work at all. I don not understand. This sample file was made from a copy of the original and them I removed the extra tabs, which are not relevant. The only thing that is different is that on the Project Status tab, all that data is formulas generated from other tabs within the workbook. Would that make a difference? That never dawned on me, so forgive me if that is the issue. However, other than that... identical.

KjBox,

Yes it did work properly. I am sorry about the confusion. It was my fault. I did not even see your button on the page. As a normal habit I went to Run the macro I the traditional sense. I do have one additional request I would like to add these lit of colors to my tab named "Codes", and I can put the button there too... I would like to the VBA to be aimed at the sheet called "Project Status" rather than the active sheet. there will be many people in this workbook, and I want to keep them away from this if possible. The color tab resided in columns A & B of my Codes tab. Can you adjust the code to account for it being on Codes rather than the colors tab, and also set it to be not require being the active sheet but specifically the Project Status tab where the chart is. And one last thing. Can this code be adjusted to run like a regular macro rather than the button? I will be the only one using this macro to manage the project colors.

Thanks so very much!!!!