Posts by Rurkz

  • Row color change if specific cells have any value

    1. cell K2 remains Yellow and does not interfere with the input of Dates.

    ( this function i wont need)


    2. After an input in Column K, Change Row color to Green if Date Delivered (Column I) And Date Paid (Column J) are BOTH filled in.

    (this is correct, and copy to outstanding and completed sheet)


    3. After an input in Column K, Change Row color to Red if Date Paid (Column J) is Empty.

    (this is correct and copy to outstanding sheet)

  • Row color change if specific cells have any value

    so this whole time i thought it was in the coding but it was a simple color change in the header lol


    but your right, the consequence is anything i add in that column turns red. is it possible to turn it green if Date delivered and date paid is filled in? and still have the red color option if date paid is not filled in?

  • Row color change if specific cells have any value

    the second tweak, since you have a better understanding



    currently your setup is if values entered in :


    Column I (Date delivered), turns the row red


    Column J (Date paid), turns the row green


    if these conditions are met and i enter a value in column K (Date Collected)


    ill like the row to stay green and copy to my completed sheet



    also is it possible to change the color for Column L from blue to yellow. i use to have it as a overweight tab but now ill just use it for notes

  • Row color change if specific cells have any value

    so I have a work sheet that was put together by someone here a long time ago. I realized I have 2 tweaks I want to do specifically for this file, hopefully some can help me out, and if all goes well ill like to merge another file to work with this. but let's focus on this first.


    my table runs from A2 to L2, my headers are in row 2, and my data info starts at row 3


    So on sheet 1, i currently have it set up if a value is inputted in column I, that row turns red. if a value is inputted in column J, that row turns green, and if a value is inputted in column K, that row turns yellow.( I want to keep this setup, but change the yellow to red)


    what I have now is if column I has any value, and column J is empty, and column K has any value the row turns yellow and copies to sheet 2 if those conditions are met


    what I want to change is basically the color from yellow to red, I'm guessing the row can stay red and still copy to sheet 2


    my 2nd tweak is if column I and J have any values in their cells, the row will stay green(of course) but will continue to stay green if I input any value to column K and will then copy to sheet 3 if those conditions are met.


    I tried playing with the formulas but I gave up. so here is my coding


    Sheet 1

  • Automatically save file to specific folders base on cell name????

    now im stuck here, cant figure out how to save as a pdf file to the same folder


    36 Sub SaveAspdf()

    37

    38 Dim invno As Long

    39 Dim invna As String

    40 Dim address As String

    41 Dim custname As String

    42 Dim path As String

    43 Dim fname As String

    44

    45 path = "C:\Users\xrurk\Google Drive\Junk Alert Office Work\Accounting\Invoices\"

    46 invno = Range("F5")

    47 invna = Range("B3")

    48 address = Range("B22")

    49 custname = Range("B13")

    50 fname = invna & " " & invno & " - " & custname

    51

    52 ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, IgnorePrintAreas:=False, Filename:=path & fname

    53

    54 End Sub

  • Automatically save file to specific folders base on cell name????

    thats where im stuck lol no idea how to adapt the coding to my existing file via vba, but i can figure out where to setup "path to save to" and "path lookup" from the example of the video. here is the coding currently using


    1 Sub EmailAspdf()

    2

    3 Dim EApp As Object

    4 Set EApp = CreateObject("Outlook.application")

    5

    6 Dim Eitem As Object

    7

    8

    9 path = "C:\Users\xrurk\Google Drive\Junk Alert Office Work\Accounting\Invoices\"

    10 invno = Range("F5")

    11 invna = Range("B3")

    12 address = Range("B22")

    13 custname = Range("B13")

    14 fname = invna & " " & invno & " - " & custname

    15

    16 ActiveSheet.ExportAsFixedFormat _

    17 Type:=xlTypePDF, _

    18 IgnorePrintAreas:=False, _

    19 Filename:=path & fname

    20

    21 Set Eitem = EApp.CreateItem(0)

    22

    23 With Eitem

    24

    25 .To = Range("B16")

    26 .Subject = " " & address & " - " & invna & " " & invno

    27 .Body = "Please Find Invoice Attached. If Paying By E-Transfer, Please Add Invoice Number or Address In the comment section of the E-Transfer!"

    28 .Attachments.Add (path & fname & ".pdf")

    29 .Display

    30

    31 End With

    32

    33 End Sub

    34

    35

    36 Sub SaveAspdf()

    37

    38 Dim invno As Long

    39 Dim invna As String

    40 Dim address As String

    41 Dim custname As String

    42 Dim path As String

    43 Dim fname As String

    44

    45 path = "C:\Users\xrurk\Google Drive\Junk Alert Office Work\Accounting\Invoices\"

    46 invno = Range("F5")

    47 invna = Range("B3")

    48 address = Range("B22")

    49 custname = Range("B13")

    50 fname = invna & " " & invno & " - " & custname

    51

    52 ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, IgnorePrintAreas:=False, Filename:=path & fname

    53

    54 End Sub

    55

    56 Sub saveinvasExcel()

    57

    58 Dim invno As Long

    59 Dim invna As String

    60 Dim address As String

    61 Dim custname As String

    62 Dim path As String

    63 Dim fname As String

    64

    65 path = "C:\Users\xrurk\Google Drive\Junk Alert Office Work\Accounting\Invoices\"

    66 invno = Range("F5")

    67 invna = Range("B3")

    68 address = Range("B22")

    69 custname = Range("B13")

    70 fname = invn2 a & " " & invno & " - " & custname

    71

    72 'copy the invoice sheet to a new workbook

    73

    74 Sheet1.Copy

    75

    76 'then delete all the buttons on the worksheet

    77

    78 Dim shp As Shape

    79

    80 For Each shp In ActiveSheet.Shapes

    81 If shp.Type <> msoPicture Then shp.Delete 'This line is modified so that is doesn't delete the logo

    82 Next shp

    83

    84 'save the new workbook to a specified folder

    85 With ActiveWorkbook

    86 .Sheets(1).Name = "Invoice"

    87 .SaveAs Filename:=path & fname, FileFormat:=52

    88 .Close

    89 End With

    90

    91

    92

    93 End Sub

  • Automatically save file to specific folders base on cell name????

    Hey so i will try my best to describe my intentions here

    I have an invoice setup with 4 buttons on the side, one to save as a excel file, second to save as a pdf file and the 3rd button sends a pdf as an email through outlook. the 4th button just clears specific cells in the invoice.


    When i save the the file it copies values in specific cells and saves it in a specific folder


    for example


    "Invoice"(B3), "900"(F5), "Business Name"(B13(merged)C13)


    Looks like this:


    "Invoice 900 Business Name"


    So, is it possible to tweak this to have the same save options but the "business name "will automatically save to the related business name sub folder if changed in excel.


    i hope that makes sense

  • Copy a row from one spread sheet to another with conditions

    Hey so im looking for a lil bit of help here,


    Early in the year i had some help create a bin log file for me on this site, eventually i realized i was missing one more function.


    Ok so in the 1st picture i provided "Main Sheet", i had the rows from A-L copied to the next available row in Outstanding Bins only if column "I" (Date Delivered) is filled and then column "k"(Date Collected) is filled in afterwards. You can see this in the second picture i provided for "Outstanding Bins".


    What i want to accomplish also is have rows from A-L copied to the next available row in "Completed jobs" only if column "I" (Date Delivered) is filled in, column "J" (Date Paid) is filled in, and then column "k"(Date Collected) is filled in afterwards.


    I Tried brainstorming this on my own and could not figure it out since im a complete noob, here is the code provided from the Main sheet Tab



    Option Explicit


    '''''''''''''''''''''''''''''''''''

    ' Version 6.2 - dated 11 Mar 2021 '

    '''''''''''''''''''''''''''''''''''


    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    ' Use Mouse Left Double-Click to Sort Ascending on Any Header Title

    ' AND

    ' in Column Date Delivered ... it deletes data in 4 last Columns I to L

    If Target.Column > 12 Then Exit Sub

    If Target.Row = 2 Then

    Select Case Target.Column

    Case 1

    Application.Run ("CustomSort")

    Case 9 ' Red

    Call SortByColour1(Target)

    Case 10 ' Green

    Call SortByColour2(Target)

    Case 11 ' Yellow

    Call SortByColour3(Target)

    Case 12 ' Blue

    Call SortByColour4(Target)

    Case Else

    Call StandardSort(Target)

    End Select

    Else

    ' Whenever Column A (i.e. #1) - sheet Bins # is Double-Clicked '''''''''

    If Target.Column <> 1 Then Cancel = True: Exit Sub

    Dim x As Long: x = Target.Row

    ' Clear Contents in Columns B to L

    Range(Cells(x, 2), Cells(x, 12)).ClearContents

    ' Delete Interior Color

    Range(Cells(x, 1), Cells(x, 12)).Interior.Color = xlNone

    End If

    Cancel = True

    End Sub



    Private Sub Worksheet_Change(ByVal Target As Range)

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ' Objective of this Event Macro :

    ' to copy and auto-populate the next available row in Outstanding Bins sheet

    ' ONLY if date delivered (Column K) AND date collected (Column I) are filled BUT NO date paid (Column J) ...

    ' For the Overweight Fee (Column L), if filled, it will auto-fill the next available row in overweight sheet.

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    If Target.CountLarge > 1 Then Exit Sub

    If Target.Column > 12 Then Exit Sub

    Dim lRow As Long, j As Long

    Dim x As Long: x = Target.Row

    Dim y As Long: y = Target.Column


    ' Deal with Exceptions : If input is deleted from any of the Last 4 Columns ...

    ' Interior Color for Entire Row MUST be re-adjusted ....

    ' To be aligned with Conditional Formatting rule ....

    ' Revert Font Color from White to Black

    If y > 8 And IsEmpty(Target) Then

    With Range(Cells(x, 1), Cells(x, 12))

    .Font.Color = vbBlack

    .Font.Bold = False

    For j = 9 To 12

    If Not IsEmpty(Cells(x, j)) Then

    .Interior.Color = Cells(2, j).Interior.Color

    Exit For

    Else

    .Interior.Color = xlNone

    End If

    Next j

    End With

    Exit Sub

    End If

    ' Standard Process

    Select Case y

    Case 4

    ' Add Sales Tax 13% for Non-Cash Payments

    If Target <> "Cash" Then Target.Offset(0, -1) = Target.Offset(0, -1) * 1.13

    Case 6

    ' Add $15 for each Extra Day

    If Target >= 1 Then Target.Offset(0, -3) = Target.Offset(0, -3) + (15 * Target.Value)

    Case 9, 10

    '

    Range(Cells(x, 1), Cells(x, 12)).Interior.Color = Cells(2, y).Interior.Color

    Case 11

    ' Outstanding Bins

    Range(Cells(x, 1), Cells(x, 12)).Interior.Color = Cells(2, y).Interior.Color

    With Sheets("Outstanding Bins")

    lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1

    ' No Date Paid and Yes Date Delivered

    If Target.Offset(, -1) = "" And IsDate(Target.Offset(0, -2)) Then

    Range(Cells(x, 1), Cells(x, 12)).Copy Destination:=.Range("A" & lRow)

    End If

    Target.Activate

    End With

    Case 12

    ' Overweight Bins

    Range(Cells(x, 1), Cells(x, 12)).Interior.Color = Cells(2, y).Interior.Color

    With Sheets("Overweight Bins")

    lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1

    Range(Cells(x, 1), Cells(x, 12)).Copy Destination:=.Range("A" & lRow)

    Target.Activate

    End With

    End Select

    End Sub