Posts by Miceal

Re: Vba that get data from sheet that precede the active sheet

There is something else going on with your VBA ... send me your file with either script installed so that I can see what you are missing.

FYI ... both scripts are activated when you create a new tab using the icon to the right of the tabs at the bottom of the worksheet.

P.S. I like jindon's code line ... it is more efficient and reduces my script by a line or two

Re: Vba that get data from sheet that precede the active sheet

here is the script using the new tab naming convention:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim cur_sheet, csn As Integer
    Dim Months As Variant
    csn = Sheets.Count
    Months = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
    On Error GoTo dup_name
    ActiveSheet.Name = Months(Month(Date) - 1) & " " & Day(Date) ' Automatically renames your new sheet to the current date
    On Error GoTo 0
    Cells(1, 1) = "OPEN STOCK" ' Adds your column headings
    Cells(1, 2) = "STOCK VARIATION"
    Cells(1, 3) = "CLOSE STOCK"
    If Sheets.Count = 1 Then Exit Sub ' If this is the first tab ... scripts will exit
    If Application.WorksheetFunction.Sum(ActiveWorkbook.Sheets(Sheets.Count - 1).Range("C2:C6")) = 0 Then Exit Sub '  if the previous day has no numbers in column C ... script will exit
    Sheets(Sheets.Count - 1).Range("C2:C6").Copy ' copys STOCK CLOSE numbers from previous day
    ActiveSheet.Range("A2:A6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' paste numbers in new tab
    ActiveSheet.Range("C2:C6").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' copies formulas over to column C
    Application.CutCopyMode = False
    Cells.EntireColumn.AutoFit ' auto ajust size of columns
    Cells(2, 2).Select ' places user in first input position
    Exit Sub
dup_name:
    Err.Clear
    ActiveSheet.Name = Months(Month(Date) - 1) & " " & Day(Date) & "(" & csn & ")" ' adds tab# if duplicate name error
    Resume Next
End Sub

if you have troubles ... send me the file with the above script installed so that I can investigate why it isn't working for you

Re: Vba that get data from sheet that precede the active sheet

send me the file (.xlxm) with the script above installed

Re: Vba that get data from sheet that precede the active sheet

Hi Pevriss,
I wrote it and tested it in the file you attached. Are you sure that you pasted the above code in the "ThisWorkbook" Object? As for the tab name changes .... I'll have to alter the way it selects the previous day if you want to change the naming convention. Will there be gaps in the date(month, day) tab name for weekends, etc?

Re: Vba that get data from sheet that precede the active sheet

add this script to your ThisWorkbook Object and everytime you add a new tab it will pull the info you want from the previous day:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim cur_sheet As Integer
    ActiveSheet.Name = "DAY " & Sheets.Count            ' Automatically renames your new sheet
    Cells(1, 1) = "OPEN STOCK"                                  ' Adds your column headings
    Cells(1, 2) = "STOCK VARIATION"
    Cells(1, 3) = "CLOSE STOCK"
    cur_sheet = Split(ActiveSheet.Name, " ")(1)            ' extracts the new day number from the new tab
    If cur_sheet = 1 Then Exit Sub                              ' If this is the first tab ... scripts will exit
    If Application.WorksheetFunction.Sum(ActiveWorkbook.Sheets(Sheets.Count - 1).Range("C2:C6")) = 0 Then Exit Sub    '  if the previous day has no numbers in column C ... script will exit 
    Sheets(Sheets.Count - 1).Range("C2:C6").Copy        ' copys STOCK CLOSE numbers from previous day
    ActiveSheet.Range("A2:A6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' paste numbers in new tab
    ActiveSheet.Range("C2:C6").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' copies formulas over to column C
    Cells.EntireColumn.AutoFit                                    ' auto ajust size of columns
    Cells(2,2).select  ' places user in first input position
End Sub

Re: Adding new CASE Statements for Buttons

I updated the VBA to hide the FPK button when the MTS button is hit ... you can use the same logic to hide other buttons

Sub AddShirtType()
Dim Obj As Object
    Set Obj = ActiveSheet.Shapes(Application.Caller)
    If Obj.Name = "Button 1" Then Worksheets("Sheet1").Shapes("Button 18").Visible = False Else Worksheets("Sheet1").Shapes("Button 18").Visible = True    ' <--- hides FPK button when button MTS iis clicked
    Select Case CInt(Split(Obj.Name, " ")(1))
        Case 1, 2, 3, 4, 14
            GenerateSKU 1, Obj.AlternativeText
        Case 4, 5, 6, 7, 8, 9, 15, 16, 17, 18
            GenerateSKU 2, Obj.AlternativeText
        Case 10, 11, 12, 13, 15, 19, 20
            GenerateSKU 3, Obj.AlternativeText
    End Select
End Sub

Re: Extract Data from Drop Down List Selection

regarding 'Also, I was wondering if I added more games than 10 the current list in the "data sheet" would this be displayed in the "Model Sheet" ?':

if you ensure the named range still covers the area you want copied ... it should work fine.

Re: Extract Data from Drop Down List Selection

It stopped working because you added the two columns to sheet("Model"). If you add columns to this sheet, you will need to adjust the script to accomodate the change. The script uses the team selection pull down menus to copy the right data.

I have updated your file and added a few error traps to handle team data that doesn't exist yet .... see attached..

Also, for consistency ... I moved your 'PTs Per Minute' to sheets("Data").range("A2") ... that way it is not being overwritten when you select a team

Re: Extract Data from Drop Down List Selection

Please tell me what you are selecting when it doesn't work...

Re: Extract Data from Drop Down List Selection

You would need to name the range in the same fashion that the existing data was named. Use _ for spaces in the name range. The script will add the dashes to the team name when you select it.

Re: Adding new CASE Statements for Buttons

Besides adding the new colors and sizes, I fix up some other errors .... see enclosed...

When I have some time, I'll break your sheet down into parts and try explain what it is doing.

Re: Extract Data from Drop Down List Selection

I added some named ranges and a script that copies the data to your Model page. Script is under the Sheet1(Model) object.

see attached....

Re: Macro to generate serial numbers

is the last receipt number stored some where?

Re: Excel VBA, SQL Query not working between dates.

Anytime

Re: Excel VBA, SQL Query not working between dates.

Here is the data I put into the database:
[TABLE="width: 286"]

DateTimeStamp

QualityTag

10/17/2014 12:00:00 AM

Good

10/18/2014 12:00:00 AM

Good

10/19/2014 12:00:00 AM

Good

10/20/2014 12:00:00 AM

Good

10/21/2014 12:00:00 AM

Good

10/22/2014 12:00:00 AM

Good

10/23/2014 12:00:00 AM

Good

10/24/2014 12:00:00 AM

Good

10/25/2014 12:00:00 AM

Good

10/26/2014 12:00:00 AM

Good

10/27/2014 12:00:00 AM

Good

10/28/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Not Good

10/29/2014 12:00:00 AM

Not Good

10/29/2014 12:00:00 AM

Not Good

10/29/2014 12:00:00 AM

Not Good

10/29/2014 12:00:00 AM

Not Good

10/29/2014 12:00:00 AM

Not Good

10/29/2014 12:00:00 AM

Not Good

10/30/2014 12:00:00 AM

Not Good

10/30/2014 12:00:00 AM

Not Good

10/30/2014 12:00:00 AM

Not Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/29/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/30/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

10/31/2014 12:00:00 AM

Good

11/1/2014 12:00:00 AM

Good

11/2/2014 12:00:00 AM

Good

11/3/2014 12:00:00 AM

Good

11/4/2014 12:00:00 AM

Good

11/5/2014 12:00:00 AM

Good

11/6/2014 12:00:00 AM

Good

11/7/2014 12:00:00 AM

Good

11/8/2014 12:00:00 AM

Good

11/9/2014 12:00:00 AM

Good

11/10/2014 12:00:00 AM

Good

[/TABLE]

here is the VBA script I used to querie the database:

Sub Date_check_for_zhivkovasilev()


Dim db As Database
Dim rst As Recordset
Dim rec_QTY As Long
    
            Set db = OpenDatabase("C:\D_test.mdb")
            fromDate = Format(Sheets("Main").Cells(15, 2), "####")
            toDate = Format(Sheets("Main").Cells(17, 2), "####")
        
        
        Set rst = db.OpenRecordset("SELECT * FROM Trends WHERE QualityTag= 'Good' AND DateTimeStamp >=  " & fromDate & " AND DateTimeStamp <= " & toDate & "")
        Sheets.Add
        
        With ActiveSheet.Cells(2, 1)
            rec_QTY = .CopyFromRecordset(rst)
        End With
        
Clean_up:
    rst.Close
    db.Close
    
End Sub

Here is the result of the SQL querie:
[TABLE="width: 220"]

[TD="align: right"]10/25/2014 0:00[/TD]

Good

[TD="align: right"]10/26/2014 0:00[/TD]

Good

[TD="align: right"]10/27/2014 0:00[/TD]

Good

[TD="align: right"]10/28/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/29/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[TD="align: right"]10/30/2014 0:00[/TD]

Good

[/TABLE]

the script should have worked for you .... check to see that your DateTimeStamp field in the Trends table is set to a date format.

Re: Excel VBA, SQL Query not working between dates.

cut and paste the new code that you used, so that I can look at it (and try it in a test database)

Re: Excel VBA, SQL Query not working between dates.

Did you do the changes I recommended above?

It will convert the dates into a numeric value so you don't need to worry about the date format you are using.

I could not get your select statement to work on a test data dase that I set up. The select statement that I recommended worked on the test database

Re: Excel VBA, SQL Query not working between dates.

I would recommend the following changes:

fromDate = Format(Sheets("Main").Cells(15, 2),"####") 
toDate = Format(Sheets("Main").Cells(17, 2),"####")

change your dselect statement to:

SELECT * FROM Trends WHERE QualityTag='Good' AND DateTimeStamp >=  " & fromDate & " AND DateTimeStamp <= " & toDate & "")

Re: Using Cell Contents as Math Operation

Sub do_what_olivetwist_wants()
    Range("A2,A4") = "+"
    Range("A6") = (Range("A1") * 1) + (Range("A3") * 1) + (Range("A5") * 1)
End Sub

I multiplied the cells x 1 in case your values are stored as text

Re: Check to see if two of three adjacent cells have matching data

Sub Test_for_new()
    Word_ = "new"
    b1 = 0
    b2 = 0
    b3 = 0
    If Len(Split(LCase(Range("B1")), LCase(Word_))(0)) <> Len(Range("B1")) Then b1 = 1
    If Len(Split(LCase(Range("B2")), LCase(Word_))(0)) <> Len(Range("B2")) Then b2 = 1
    If Len(Split(LCase(Range("B3")), LCase(Word_))(0)) <> Len(Range("B3")) Then b3 = 1
    If b1 + b2 + b3 < 2 Or b1 + b2 + b3 = 3 Then Range("B4") = "No" Else Range("B4") = "Yes"
End Sub

Here is what it does:
it splits the cell using the word new ... and if the length of the first split = the length of the full cell ... then the word 'new' isn't in the cell.
The cell and variable 'Word_' are converted to lowercase to keep everything in the same context.