Posts by Max1616

Re: Formula to search for date and extract average data to the beginning of year

There may be an easier way to do this, but this is the best I can come up with to make it truly dynamic.

I will only show you how to come up with the Average formula for the dynamic date range of (First month of the year - latest month listed in your table).

First off here is the formula you can use:
A3=AVERAGE(INDIRECT("r" & ROW(A3)&"c" & MATCH(DATE(YEAR(TODAY()),1,1),$2:$2,0) &":r"&ROW(A3)&"c" &MATCH(MAX($B$2:$Z$2),$B$2:$Z$2,0)+1,FALSE))

Essentially what I am doing is using the INDIRECT formula to pull out the rows and columns we want to look at. Simplified it will read like this:
INDIRECT("RXCX:RYCY",FALSE)
Where X and Y are the row and column references for the start date and end date of your range. The trick here is to dynamically pull your rows and columns and insert them into this formula. Let me break down each part of the formula:

1. The row reference: This is the easiest section of the formula because it's just looking at the row the formula lives in:
=ROW(A3)

2. The First month of the year column: Here we just want to find the date in your headers which references the first month of the current year. We can use a simple match formula for this (This segment of the formula can be updated to show the last month of the previous year if you wanted to do that):
=MATCH(DATE(YEAR(TODAY()),1,1),$2:$2,0)

3. Last we want to find the most recent month in your headers. We will use another match formula, taking the greatest value of all your headers (Excluding column A). You can extend the bolded part out further if you plan to have more headers in the future):
=MATCH(MAX($B$2:$Z$2),$B$2:$Z$2,0)+1

I hope this makes sense.

If you delete the month of July in your attached spreadsheet then you receive these results:
A3=AVERAGE(INDIRECT("r" & ROW(A3)&"c" & MATCH(DATE(YEAR(TODAY()),1,1),$2:$2,0) &":r"&ROW(A3)&"c" &MATCH(MAX($B$2:$Z$2),$B$2:$Z$2,0)+1,FALSE)) = 96.83
A4=AVERAGE(INDIRECT("r" & ROW(A4)&"c" & MATCH(DATE(YEAR(TODAY()),1,1),$2:$2,0) &":r"&ROW(A4)&"c" &MATCH(MAX($B$2:$Z$2),$B$2:$Z$2,0)+1,FALSE)) = 94.83
A5=AVERAGE(INDIRECT("r" & ROW(A5)&"c" & MATCH(DATE(YEAR(TODAY()),1,1),$2:$2,0) &":r"&ROW(A5)&"c" &MATCH(MAX($B$2:$Z$2),$B$2:$Z$2,0)+1,FALSE)) = 95.17

Which lines up exactly with your formula for the Avg of June.

Sincerely,
Max

Re: Lock row after pressing save

Step one: Unlock all of your cells (The cells default to locked when a workbook is created) Format Cells->Protection->Uncheck Locked Box
Step two: Place this code in the worksheet module of the sheet you would like to protect:

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Cells(Target.Row, 1000) = "x"
End Sub

Step Three: Place this code in the workbook module:

Option Explicit


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim pw As String
Dim lrow As Long
Dim i As Long


Set ws = Sheets("Sheet1") 'Specify Sheet Name Here
pw = "Test" 'Specify Password Here
lrow = ws.Cells(Rows.Count, 1000).End(xlUp).Row


On Error Resume Next
ws.Unprotect Password:=pw


For i = 1 To lrow
    If ws.Cells(i, 1000) = "x" Then ws.Rows(i).Locked = True
Next i


Columns(1000).ClearContents


On Error Resume Next
ws.Protect Password:=pw


End Sub

Step Four: Update these two lines of code in the code you pasted into the workbook module in step three:

Set ws = Sheets("Sheet1") 'Specify sheet name here in the quotations
pw = "Test" 'Specify password here in the quotations

Step Five: Save your workbook.
Step Six: Start editing records, when saved (and only when saved) will your rows then become locked if edited.

*Note, this will also lock your header row. If you do not want it to lock your header row change this line of code:

For i = 1 To lrow

to

For i = 2 To lrow

I hope this solution works for you!

Sincerely,
Max

Re: Create if condition between two dates

If you are only excluding Sundays then try this:

=IF(B2=(A2+1),"OK",IF(TEXT(A2,"DDD")="Sat",IF(A2=B2-2,"OK","")))

A2 = In
B2 = Out

The Logic here is: (If In = Out -1 Then "OK", If not then(If the In-day is Saturday then (If In = Out -2 then "OK", if not then "")))

Sincerely,
Max

Re: Find matching value on left

I went to Seattle with my GF, it was a lot of fun!

The custID=custID+0 is actually adjusting what data type excel assigns to the value of custID.

Essentially if you customer's id is a number in your table, then excel is reading it as a data type 1 (numerical), but your custID variable in your code is automatically being assigned a data type of 2 (Text). When comparing these two values, they need to be the same type in order for lookup functions to work properly. So what I'm doing here is adding a 0, forcing excel to treat this variable as a numeric type, this would obviously error out on a alphanumeric string so that is why the 'is error resume next' was placed above it.

This is the first time I've ever encountered this issue with VBA, usually I see this type of thing when you are using index/match formulas within excel. If you do ever get an error with a lookup formula, and it should be working properly, you can use the =Type() function to check the data types of your cells and make sure they are the same type. adding a 0 or multiplying by 1 will force excel to change a data type of a value to numeric, and using =Text(cell,"#") will change it to a text type:

=Vlookup(A1+0,D1:Z25,13,False) - Changes the lookupvalue (A1) to type 1 (Numeric)
=Vlookup(Text(A1,"#"),D1:Z25,13,False) - Changes the lookupvalue (A1) to type 2 (Text)

Here's a pretty in depth explanation if you want to learn more.
http://johnatten.com/2011/10/0…t-ii-data-types-in-excel/

Sincerely,
Max

Re: Find matching value on left

Sorry for the delay in response, I was on vacation. Give this a shot:

Private Sub btnCustID_Click()
     'If nothing was input
    If Me.tbCustID.Value = "" Then
        MsgBox ("Input Customer's ID in Customer's ID field")
        Exit Sub
    End If
     
     'Check if value non existing
    If WorksheetFunction.CountIf(Sheet1.Range("D:D"), Me.tbCustID.Value) = 0 Then
        MsgBox ("Customer's ID not found")
        Exit Sub
    End If
     
     'Save Customer's ID
    Dim custID As Variant
    custID = Me.tbCustID.Value
     'Clean Everything!
    ClearFields
     
     'Restore Customer's ID
    On Error Resume Next
    custID = custID + 0
     'If existing, find the ticket number and then just do a ticket number search.
    With Me
        On Error Resume Next
        .tbTicketNo = Cells(WorksheetFunction.Match(custID, Sheets("Issue Log").Range("D:D"), 0), 2)
        If .tbTicketNo = "" Then
            MsgBox "Ticket number does not exits"
            Exit Sub
        End If
         'MsgBox .tbTicketNo
        btnSearchByTicketNo_Click
    End With
End Sub

Re: Message Box and Selection Change

I think I'm confused as to what you are trying to accomplish. First, you want to use this sub so it doesn't fire every time you select a new cell:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Range("b1") = "" Then
        MsgBox "Must input Name before continuing"
    ElseIf Range("b2") = "" Then
        MsgBox "Must input Strength before continuing"
    ElseIf Range("b3") = "" Then
        MsgBox "Must input if Preservative Free before continuing"
    ElseIf Range("b4") = "" Then
        MsgBox "Must input Units Requested before continuing"
    ElseIf Range("b5") = "" Then
        MsgBox "Must input Packaging before continuing"
    ElseIf Range("c5") = "" Then
        MsgBox "Must input Unit of Measurement before continuing"
    ElseIf Range("d5") = "" Then
        MsgBox "Must input Container Type before continuing"
    ElseIf Range("b6") = "" Then
        MsgBox "Must input Projected Use before continuing"
    ElseIf Range("b7") = "" Then
        MsgBox "Must input Route of Admin before continuing"
    ElseIf Range("b8") = "" Then
        MsgBox "Must input Customer Type before continuing"
    ElseIf Range("b9") = "" Then
        MsgBox "Must input Current Price before continuing"
    End If
    Application.EnableEvents = True
End Sub

Second, wouldn't it make more sense to put this validation at the start of your macro?

Re: Help with Vlookup VBA

I'm not sure what your lookup references are but you can use something like this, which will give you the value:

Range("J2") = WorksheetFunction.VLookup(Range("A1"), Sheets("Worked Accounts").Range("B1:K10"), 10, False)

If you want the formula then use this:

Range("J2") = "=Vlookup(A1,'Worked Accounts'!B1:K10,10,False"

If you give me the formula without the R1C1 references I can give you a better suited formula.

Re: finding the number of companies a director is siting

Place this in Cell D2:
=COUNTIFS(C:C,C2)-1

Place this in Cell E2:
=COUNTIFS(C:C,C2,A:A,A2)-1

Sincerely,
Max

Re: Paste the row with value >0 in output sheet

Here you go:

Option Explicit


Sub nishalmenezes()
Dim WsI As Worksheet
Dim WsO As Worksheet
Dim i1 As Long
Dim i2 As Integer
Dim lrowI As Long
Dim lrowO As Long
Dim ValClm As Integer
Dim LValClm As Integer
Dim StartClmI As Integer
Dim StartRowI As Integer




Set WsI = Sheets("Sheet1") 'Update this to the Input sheet name
Set WsO = Sheets("Sheet2") 'Update this to the Output sheet name


With WsO
    .Cells(1, 1) = "Company"
    .Cells(1, 2) = "Location"
    .Cells(1, 3) = "Product"
    .Cells(1, 4) = "MFG Date"
    .Cells(1, 5) = "Value"
    .Cells(1, 6) = "Mode"
End With


lrowI = WsI.Cells(Rows.Count, 1).End(xlUp).Row
StartClmI = 1 'Assums start column of your data in the input sheet is column A
StartRowI = 2 'Assums start Row of your data in the input sheet is Row 2
ValClm = StartClmI + 4
LValClm = WsI.Cells(1, StartClmI).End(xlToRight).Column - 1




For i1 = StartRowI To lrowI
    For i2 = ValClm To LValClm
        lrowO = WsO.Cells(Rows.Count, 1).End(xlUp).Row + 1
        If WsI.Cells(i1, i2) <> 0 Then
            With WsO
                .Cells(lrowO, 1) = WsI.Cells(i1, StartClmI)
                .Cells(lrowO, 2) = WsI.Cells(i1, StartClmI + 1)
                .Cells(lrowO, 3) = WsI.Cells(i1, StartClmI + 2)
                .Cells(lrowO, 4) = WsI.Cells(i1, StartClmI + 3)
                .Cells(lrowO, 5) = WsI.Cells(i1, i2)
                .Cells(lrowO, 6) = WsI.Cells(i1, LValClm + 1)
            End With
        End If
    Next i2
Next i1


End Sub

Make sure you update the sheet names and the start column and row, as noted in the code. Defaults are as follows:

Input sheet: "Sheet1"
Output sheet: "Sheet2"

Start Row of Input data (Excluding headers): 2
Start Column of Input data: 1 (A)

Re: Find matching value on the left

Try this:

Private Sub btnCustID_Click()
    'If nothing was input
    If Me.tbCustID.Value = "" Then
        MsgBox ("Input Customer's ID in Customer's ID field")
        Exit Sub
    End If
    
    'Check if value non existing
    If WorksheetFunction.CountIf(Sheet1.Range("D:D"), Me.tbCustID.Value) = 0 Then
        MsgBox ("Customer's ID not found")
        Exit Sub
    End If
    
    'Save Customer's ID
    Dim custID
    custID = Me.tbCustID.Value
    
    'Clean Everything!
    ClearFields
    
    'Restore Customer's ID
    Me.tbCustID.Value = custID
    
    'If existing, find the ticket number and then just do a ticket number search.
    With Me
        On Error Resume Next
        .tbTicketNo = Cells(WorksheetFunction.Match(custID, Sheets("Issue Log").Range("D:D"), 0), 2)
        If .tbTicketNo = "" Then
            MsgBox "Ticket number does not exits"
            Exit Sub
        End If
        'MsgBox .tbTicketNo
        btnSearchByTicketNo_Click
    End With
End Sub

I commented out the msgbox that shows what the Ticket No. is. Remove the comment to see the msgbox.

Sincerely,
Max

Re: Find matching value on the left

.

Re: Nested Loops Quit after one successful round

Also Skywriter is 100% correct, follow his advice!

Re: Nested Loops Quit after one successful round

I think this might be because you activated a new wb (FinanceData) at the end of your loop, so when it moves to the next item in the loop your code is focusing on (FinanceData) and not (UtilData).

Try this:

Global UtilData As String 
Global FinanceData As String 
Global ULastCol As Integer 
 '________________________________
 
Sub Months() 
     
    Dim FLastCol As Integer 
    Dim FLastRow As Integer 
    Dim UCAC As String 
    Dim ULastRow As Integer 
    Dim FFindCell As Range 
    Dim SrchCell As String 
    Dim CurrentUCAC As String 
     
     '**** Some set-up code - I am not having problems with this code, just including it for reference****
     
     'Workbooks(UtilData) is the workbook with the updated format.
     'Workbooks(FinanceData) is the workbook with the original data in its original format. This version works great for our finance folk, but not so much for my analyses.
     
    UtilData = ActiveWorkbook.Name 
     'Message Box offers to open and identify the new Finance Data file.
    iReply = MsgBox("Please open the new utility data file. The Macro will copy / paste the new data into the existing table.", vbOKCancel, Title:="Launch Transfer") 
    If iReply = vbOK Then 
        Application.FindFile 
        FinanceData = ActiveWorkbook.Name 
    End If 
     
    Workbooks(UtilData).Sheets("Utility Data").Activate 
    ULastCol = Cells(1, Columns.Count).End(xlToLeft).Column 
     
    Workbooks(FinanceData).Activate 
    FLastCol = Cells(1, Columns.Count).End(xlToLeft).Column 
    FLastRow = Cells(Rows.Count, 7).End(xlUp).Row 
     
     'Use "City Acct Code" as anchors to copy / paste data. There will be a separate row for each month.
    Redim UCAC(2 To FLastRow) 
    For i = 2 To FLastRow 
        UCAC(i) = Cells(i, 3) 
    Next 
     
     '***End Set-up Code*********
     
     
     
    Workbooks(UtilData).Sheets("Utility Data").Activate 
    ULastRow = Cells(Rows.Count, 3).End(xlUp).Row 
    Workbooks(FinanceData).Activate 
     
     
    SrchCell = "July kwh" 
    For x = 2 To FLastRow 
        CurrentUCAC = UCAC(x) 'If this looks funky, that's because I use the String in another bank of code not shown here. However, I'm not convinced this is the problem bc the loop never makes it back to this variable.
        If Cells(x, 3) = CurrentUCAC Then 
             
             
            For y = 7 To 19 'This is the loop that is failing.
Workbooks(UtilData).Activate 'This is what I added in
                Set FFindCell = Cells(1, y).Find(SrchCell, LookIn:=xlValues) 
                If Not FFindCell Is Nothing Then 
                    Cells(x, y).Copy 
                    Workbooks(UtilData).Sheets("Utility Data").Activate 
                     
                    For w = 3 To ULastRow 
                        If Cells(w, 3) = CurrentUCAC And Cells(w, 9) = SrchCell Then 
                            Cells(w, 11).PasteSpecial (xlPasteValues) 
                            Workbooks(FinanceData).Activate 
                            FFindCell.Offset(0, 1).Select 
                            SrchCell = ActiveCell 
                        End If 
                    Next 'Everything works great until this loop has one successful completion of code (i.e. it successfully copy/pastes values). Then the Sub just ends, and does not finish 'y = 7 to 19'
                     
                End If 
            Next 'This is the loop that is failing. I want 'y' to run through columns 7 to 19, currently it's quitting at 8. Column 8 is the first relevant column to the copy/paste method.
        End If 'This loop is not completed either. 'x' should loop to row 900-ish. If I create breakpoints and run the program slowly, it runs perfect! But it I let it run on its own, at full speed, it does one successful loop and ends.
    Next 
     
End Sub

Re: match multiple criteria on 2 sheets to get TRUE

NBVC, Your formula is reading: If the target date exists in sheet 2 and the target name exists in sheet two then return "True". This doesn't check to see if the targets exist in the same row in sheet two. Now you can add another portion of the formula to check to make sure they are in the same row:

=IF(AND(ISNUMBER(MATCH(G2,Sheet2!A:A,0)),ISNUMBER(MATCH(C2,Sheet2!B:B,0)))=TRUE,IF(MATCH(G2,Sheet2!A:A,0)=MATCH(C2,Sheet2!B:B,0),"True","False"))

But the issue with this: If there are multiple instance of the same name or same date, then the match will always return the very first instance of the value. So a record could be a "True" match but the formula will read as false if there the same date/name is entered higher in the list.

The only way (I can come up with) to solve this problem is by using an array formula that checks for the existence of each date/name in every row.

That being said, I agree, it takes up a lot of memory usage and a macro would be more efficient.

I hope this all makes sense.

Sincerely,
Max

Re: match multiple criteria on 2 sheets to get TRUE

The formula you used from me was not entered in as an array formula. Double click into the first cell and click control+shift+enter. Once you have done this the formula should look like this:
{=IF(SUM(IF(G2=Sheet2!A:A,IF(C2=Sheet2!B:B,1,0)))>0,"True","False")}

Then drag it down and it will work. The formula has to be entered as an array formula though!
http://www.excel-easy.com/functions/array-formulas.html

Re: match multiple criteria on 2 sheets to get TRUE

Sorry for the delay, I was out nursing a hangover and didn't come into work where I normally help on this forum.

This is definitely doable. You need to use an array formula for it though. For your specific example you need to use this:

{=IF(SUM(IF(G2=Sheet2!A:A,IF(C2=Sheet2!B:B,1,0)))>0,"True","False")}

*This is an array formula. When you are typing in the formula, once you are ready to enter it press control+shift+enter

Here is the template you can use if your data set changes regularly:{=IF(SUM(IF(FirstNameInDataSet=Sheet2!Column:ColumnOfNameRange,IF(FirstDateInDataSet=Sheet2!Column:ColumnOfDateRange,1,0)))>0,"True","False")}

Let me know if this works.

Sincerely,
Max

Re: Finding the Nth incident of a text string using match

Lets say your data set is in column A, your nth number is in cell F5, and your value (bill) is in cell F6.

{=SMALL(IF(A:A=F6,ROW(A:A)-ROW(INDEX(A:A,1,1))+1),F5)}

So in your particular data set, if you have F5= 2 and F6 = "Bill", your result will be 4

*This is an array formula, make sure when you are done type the formula to press cntrl+shift+enter.

Sincerely,
Max

Re: Trying to match multiple criteria on 2 sheets to get value of "true"

Does row 1 on sheet 1 correspond with row 1 on sheet 2? If so you can use this:

=IF(AND(Sheet1!B1=Sheet2!A1,Sheet1!A1=Sheet2!H1)=TRUE,"True","False")

(I'm assuming your employee name is in sheet1 A and sheet2 H, per your formula.)

If you provide your workbook with an example of what you want to see it would be easier to help solve your issue.

Sincerely,
Max

Re: Insert row where sequential value is missing, including first and last values.

Can you attach a workbook of what your data looks like?

Re: Determine last occurrence of item in a table

You can do something easy like this to create a column that sums up the kg for that specific customer on that specific day:

Macro:

Sub PalletCalc()


Dim lrow As Long
Dim i As Long


lrow = Cells(Rows.Count, 1).End(xlUp).Row


For i = 2 To lrow
    Cells(i, 9) = WorksheetFunction.SumIfs(Columns(7), Columns(3), Cells(i, 3), Columns(1), Cells(i, 1))
Next i
End Sub

This works too if you want a formula:
*place in I2, then drag down

=SUMIFS(G:G,A:A,A2,C:C,C2)

With either of these you can now look at that record to see that customers total Kgs for that given customer/day combination.The formula would be the fastest way to accomplish this without running a loop which could take a lot of time with 700k + rows.